(** * Conditions for innocuous double rounding. *)

Require Import Fcore_Raux.
Require Import Fcore_defs.
Require Import Fcore_generic_fmt.
Require Import Fcalc_ops.
Require Import Fcore_ulp.
Require Fcore_FLX Fcore_FLT Fcore_FTZ.

Require Import Psatz.

Open Scope R_scope.

Section Double_round.

Variable beta : radix.
Notation bpow e := (bpow beta e).
Notation ln_beta x := (ln_beta beta x).

Definition double_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 [(Fcore_Raux.bpow _ _ * Fcore_Raux.bpow _ _)] =>
        rewrite <- bpow_plus
      | |- context [(?X1 * Fcore_Raux.bpow _ _ * Fcore_Raux.bpow _ _)] =>
        rewrite (Rmult_assoc X1); rewrite <- bpow_plus
      | |- context [(?X1 * (?X2 * Fcore_Raux.bpow _ _) * Fcore_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 [(Fcore_Raux.bpow _ ?X)] =>
        progress ring_simplify X
    end;
  (* bpow 0 ~~> 1 *)
  change (Fcore_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 double_round_lt_mid_further_place' :
  forall (fexp1 fexp2 : Z -> Z),
  Valid_exp fexp1 -> Valid_exp fexp2 ->
  forall (choice1 choice2 : Z -> bool),
  forall x,
  0 < x ->
  (fexp2 (ln_beta x) <= fexp1 (ln_beta x) - 1)%Z ->
  x < bpow (ln_beta x) - / 2 * ulp beta fexp2 x ->
  x < midp fexp1 x - / 2 * ulp beta fexp2 x ->
  double_round_eq fexp1 fexp2 choice1 choice2 x.
Proof.
(* Goal: forall (fexp1 fexp2 : forall _ : Z, Z) (_ : Valid_exp fexp1) (_ : Valid_exp fexp2) (choice1 choice2 : forall _ : Z, bool) (x : R) (_ : Rlt (IZR Z0) x) (_ : Z.le (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Zpos xH))) (_ : Rlt x (Rminus (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x)))) (_ : Rlt x (Rminus (midp fexp1 x) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x)))), double_round_eq fexp1 fexp2 choice1 choice2 x *)
intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 x Px Hf2f1 Hx1.
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
unfold double_round_eq.
(* Goal: forall (_ : forall (_ : @eq Z (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Z.add (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH))) (_ : Rle (Rminus (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))) x), double_round_eq fexp1 fexp2 choice1 choice2 x) (_ : forall (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : and (Rle (Rminus (midp fexp1 x) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))) x) (Rlt x (midp fexp1 x))), double_round_eq fexp1 fexp2 choice1 choice2 x) (_ : forall (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : @eq R x (midp fexp1 x)), double_round_eq fexp1 fexp2 choice1 choice2 x) (_ : forall (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : and (Rlt (midp fexp1 x) x) (Rle x (Rplus (midp fexp1 x) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))))), double_round_eq fexp1 fexp2 choice1 choice2 x), double_round_eq fexp1 fexp2 choice1 choice2 x *)
set (x' := round beta fexp1 Zfloor x).
(* Goal: forall _ : Rlt x (Rminus (midp fexp1 x) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))), @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)) (round beta fexp1 (Znearest choice1) x) *)
intro Hx2'.
assert (Hx2 : x - round beta fexp1 Zfloor x
              < / 2 * (ulp beta fexp1 x - ulp beta fexp2 x)).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ now apply (Rplus_lt_reg_r (round beta fexp1 Zfloor x)); ring_simplify. }
(* Goal: forall _ : Rlt x (Rminus (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))), @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)) (round beta fexp1 (Znearest choice1) x) *)
set (x'' := round beta fexp2 (Znearest choice2) x).
(* Goal: @eq R (round beta fexp1 (Znearest choice1) x'') (round beta fexp1 (Znearest choice1) x) *)
assert (Hr1 : Rabs (x'' - x) <= / 2 * bpow (fexp2 (ln_beta x))).
(* Goal: Rle (Rabs (Rminus x'' x)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) x'') (round beta fexp1 (Znearest choice1) x) *)
apply Rle_trans with (/ 2 * ulp beta fexp2 x).
(* Goal: Rle (Rabs (Rminus x'' x)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x)) *)
(* Goal: Rle (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) x'') (round beta fexp1 (Znearest choice1) x) *)
now unfold x''; apply error_le_half_ulp...
(* Goal: Rle (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) x'') (round beta fexp1 (Znearest choice1) x) *)
rewrite ulp_neq_0;[now right|now apply Rgt_not_eq].
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)) (round beta fexp1 (Znearest choice1) x) *)
assert (Pxx' : 0 <= x - x').
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ apply Rle_0_minus.
(* Goal: Rle (IZR Z0) rd *)
  apply round_DN_pt.
  exact Vfexp1. }
(* Goal: Rlt (Rabs (Rminus x' x)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) *)
rewrite 2!ulp_neq_0 in Hx2; try (apply Rgt_not_eq; assumption).
(* Goal: @eq R (round beta fexp1 (Znearest choice1) x'') (round beta fexp1 (Znearest choice1) x) *)
assert (Hr2 : Rabs (x'' - x') < / 2 * bpow (fexp1 (ln_beta x))).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ replace (x'' - x') with (x'' - x + (x - x')) by ring.
(* Goal: Rlt (Rabs (Rplus (Rminus x'' x) (Rminus x x'))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
  apply (Rle_lt_trans _ _ _ (Rabs_triang _ _)).
  replace (/ 2 * _) with (/ 2 * bpow (fexp2 (ln_beta x))
                          + (/ 2 * (bpow (fexp1 (ln_beta x))
                                    - bpow (fexp2 (ln_beta x))))) by ring.
(* Goal: Rlt (Rplus (Rabs (Rminus x'' x)) (Rabs (Rminus x x'))) (Rplus (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) *)
  apply Rplus_le_lt_compat.
  - exact Hr1.
  - now rewrite Rabs_right; [|now apply Rle_ge]; apply Hx2. }
(* Goal: @eq R (round beta fexp1 (Znearest choice1) x'') (round beta fexp1 (Znearest choice1) x) *)
destruct (Req_dec x'' 0) as [Zx''|Nzx''].
- (* x'' = 0 *)
  rewrite Zx'' in Hr1 |- *.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (IZR Z0)) (round beta fexp1 (Znearest choice1) x) *)
  rewrite round_0; [|now apply valid_rnd_N].
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) (IZR Z0) *)
  unfold round, F2R, scaled_mantissa, canonic_exp; simpl.
(* Goal: @eq R (IZR Z0) (Rmult (Z2R (Znearest choice1 (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
  rewrite (Znearest_imp _ _ 0); [now simpl; rewrite Rmult_0_l|].
(* Goal: Rlt (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (IZR (Zpos xH)) *)
  apply (Rmult_lt_reg_r (bpow (fexp1 (ln_beta x)))); [now apply bpow_gt_0|].
  rewrite <- (Rabs_right (bpow (fexp1 _))) at 1;
    [|now apply Rle_ge; apply bpow_ge_0].
  rewrite <- Rabs_mult; rewrite Rmult_minus_distr_r.
(* Goal: generic_format beta fexp2 (Rmult (IZR Z0) y) *)
  rewrite Rmult_0_l.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
  bpow_simplify.
(* Goal: Rle (Rabs (Rminus x x'')) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x)) *)
  rewrite Rabs_minus_sym.
(* Goal: Rlt (Rabs (Rminus (IZR Z0) x)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
  apply (Rle_lt_trans _ _ _ Hr1).
(* Goal: Rlt (Rmult (Rinv (IZR (Zpos (xO xH)))) (IZR Z0)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus u1 u2)) *)
  apply Rmult_lt_compat_l; [lra|].
(* Goal: Rlt (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))))) *)
  apply bpow_lt.
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  omega.
- (* x'' <> 0 *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) x'') (round beta fexp1 (Znearest choice1) x) *)
  assert (Lx'' : ln_beta x'' = ln_beta x :> Z).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
  { apply Zle_antisym.
    - apply ln_beta_le_bpow; [exact Nzx''|].
      replace x'' with (x'' - x + x) by ring.
(* Goal: Rlt (Rabs (Rplus (Rminus x'' x) (Rminus x x'))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
      apply (Rle_lt_trans _ _ _ (Rabs_triang _ _)).
      replace (bpow _) with (/ 2 * bpow (fexp2 (ln_beta x))
                             + (bpow (ln_beta x)
                                - / 2 * bpow (fexp2 (ln_beta x)))) by ring.
(* Goal: Rlt (Rplus (Rabs (Rminus x'' x)) (Rabs x)) (Rplus (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) (Rminus (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) *)
      apply Rplus_le_lt_compat; [exact Hr1|].
(* Goal: Rlt (Rabs x) (Rminus (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) *)
      rewrite ulp_neq_0 in Hx1;[idtac| now apply Rgt_not_eq].
(* Goal: Rlt (Rabs x) (Rminus (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) *)
      now rewrite Rabs_right; [|apply Rle_ge; apply Rlt_le].
    - unfold x'' in Nzx'' |- *.
      now apply ln_beta_round_ge; [|apply valid_rnd_N|]. }
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) (IZR Z0) *)
  unfold round, F2R, scaled_mantissa, canonic_exp; simpl.
(* Goal: @eq R (Rmult (Z2R (Znearest choice1 (Rmult x'' (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x'' (Fcore_Raux.ln_beta beta x'')))))))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x'' (Fcore_Raux.ln_beta beta x''))))) (Rmult (Z2R (Znearest choice1 (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
  rewrite Lx''.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (Rmult (Z2R (Znearest choice2 (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (round beta fexp1 (Znearest choice1) x) *)
  rewrite (Znearest_imp _ _ (Zfloor (scaled_mantissa beta fexp1 x))).
  + rewrite (Znearest_imp _ _ (Zfloor (scaled_mantissa beta fexp1 x)));
    [reflexivity|].
(* Goal: Rlt (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (IZR (Zpos xH)) *)
    apply (Rmult_lt_reg_r (bpow (fexp1 (ln_beta x)))); [now apply bpow_gt_0|].
    rewrite <- (Rabs_right (bpow (fexp1 _))) at 1;
      [|now apply Rle_ge; apply bpow_ge_0].
    rewrite <- Rabs_mult.
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rmult (Rminus (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))))) *)
    rewrite Rmult_minus_distr_r.
(* Goal: Rlt (Rabs (Rminus (Rmult (Rmult x'' (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) (Rmult (Z2R (Zceil (scaled_mantissa beta fexp1 x))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
    fold x'.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    bpow_simplify.
(* Goal: Rlt (Rabs (Rminus (Rmult (Z2R (Zceil (scaled_mantissa beta fexp1 x))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) x)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
    rewrite Rabs_right; [|now apply Rle_ge].
(* Goal: Rlt (Rminus (Rmult (Z2R (Zceil (scaled_mantissa beta fexp1 x))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) x) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
    apply (Rlt_le_trans _ _ _ Hx2).
(* Goal: Rle (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rdiv (IZR (Zpos (xO xH))) (IZR (Zpos (xI xH))))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (IZR (Zpos xH)) (Fcore_Raux.bpow beta (Z.sub (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))))) *)
    apply Rmult_le_compat_l; [lra|].
(* Goal: Rle (Rminus (ulp beta fexp1 x) (ulp beta fexp2 x)) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) *)
    generalize (bpow_ge_0 beta (fexp2 (ln_beta x))).
(* Goal: forall _ : Rle (IZR Z0) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))), Rle (Rminus (Fcore_Raux.bpow beta (canonic_exp beta fexp1 x)) (Fcore_Raux.bpow beta (canonic_exp beta fexp2 x))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) *)
    unfold ulp, canonic_exp; lra.
(* Goal: Rlt (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (IZR (Zpos xH)) *)
  + apply (Rmult_lt_reg_r (bpow (fexp1 (ln_beta x)))); [now apply bpow_gt_0|].
    rewrite <- (Rabs_right (bpow (fexp1 _))) at 1;
      [|now apply Rle_ge; apply bpow_ge_0].
    rewrite <- Rabs_mult.
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rmult (Rminus (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))))) *)
    rewrite Rmult_minus_distr_r.
(* Goal: Rlt (Rabs (Rminus (Rmult (Rmult x'' (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) (Rmult (Z2R (Zceil (scaled_mantissa beta fexp1 x))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
    fold x'.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    now bpow_simplify.
Qed.

Lemma double_round_lt_mid_further_place :
  forall (fexp1 fexp2 : Z -> Z),
  Valid_exp fexp1 -> Valid_exp fexp2 ->
  forall (choice1 choice2 : Z -> bool),
  forall x,
  0 < x ->
  (fexp2 (ln_beta x) <= fexp1 (ln_beta x) - 1)%Z ->
  (fexp1 (ln_beta x) <= ln_beta x)%Z ->
  x < midp fexp1 x - / 2 * ulp beta fexp2 x ->
  double_round_eq fexp1 fexp2 choice1 choice2 x.
Proof.
(* Goal: forall (fexp1 fexp2 : forall _ : Z, Z) (_ : Valid_exp fexp1) (_ : Valid_exp fexp2) (choice1 choice2 : forall _ : Z, bool) (x : R) (_ : Rlt (IZR Z0) x) (_ : Z.le (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Zpos xH))) (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : forall _ : Rle (Rabs (Rminus x (midp fexp1 x))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x)), double_round_eq fexp1 fexp2 choice1 choice2 x), double_round_eq fexp1 fexp2 choice1 choice2 x *)
intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 x Px Hf2f1 Hf1.
(* Goal: forall _ : Rlt x (Rminus (midp fexp1 x) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))), @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)) (round beta fexp1 (Znearest choice1) x) *)
intro Hx2'.
assert (Hx2 : x - round beta fexp1 Zfloor x
              < / 2 * (ulp beta fexp1 x - ulp beta fexp2 x)).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ now apply (Rplus_lt_reg_r (round beta fexp1 Zfloor x)); ring_simplify. }
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 x *)
revert Hx2.
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
unfold double_round_eq.
(* Goal: forall (_ : forall (_ : @eq Z (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Z.add (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH))) (_ : Rle (Rminus (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))) x), double_round_eq fexp1 fexp2 choice1 choice2 x) (_ : forall (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : and (Rle (Rminus (midp fexp1 x) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))) x) (Rlt x (midp fexp1 x))), double_round_eq fexp1 fexp2 choice1 choice2 x) (_ : forall (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : @eq R x (midp fexp1 x)), double_round_eq fexp1 fexp2 choice1 choice2 x) (_ : forall (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : and (Rlt (midp fexp1 x) x) (Rle x (Rplus (midp fexp1 x) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))))), double_round_eq fexp1 fexp2 choice1 choice2 x), double_round_eq fexp1 fexp2 choice1 choice2 x *)
set (x' := round beta fexp1 Zfloor x).
(* Goal: forall _ : Rlt (Rminus (round beta fexp1 Zceil x) x) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (ulp beta fexp1 x) (ulp beta fexp2 x))), @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)) (round beta fexp1 (Znearest choice1) x) *)
intro Hx2.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)) (round beta fexp1 (Znearest choice1) x) *)
assert (Pxx' : 0 <= x - x').
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ apply Rle_0_minus.
(* Goal: Rle (IZR Z0) rd *)
  apply round_DN_pt.
  exact Vfexp1. }
assert (x < bpow (ln_beta x) - / 2 * bpow (fexp2 (ln_beta x)));
  [|apply double_round_lt_mid_further_place'; try assumption]...
2: rewrite ulp_neq_0;[assumption|now apply Rgt_not_eq].
destruct (Req_dec x' 0) as [Zx'|Nzx'].
- (* x' = 0 *)
  rewrite Zx' in Hx2; rewrite Rminus_0_r in Hx2.
(* Goal: Rlt (Rminus (Rmult (Z2R (Zceil (scaled_mantissa beta fexp1 x))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) x) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
  apply (Rlt_le_trans _ _ _ Hx2).
  rewrite Rmult_minus_distr_l.
  rewrite 2!ulp_neq_0;[idtac|now apply Rgt_not_eq|now apply Rgt_not_eq].
  apply Rplus_le_compat_r.
  apply (Rmult_le_reg_r (bpow (- ln_beta x))); [now apply bpow_gt_0|].
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
  unfold ulp, canonic_exp; bpow_simplify.
  apply Rmult_le_reg_l with (1 := Rlt_0_2).
  replace (2 * (/ 2 * _)) with (bpow (fexp1 (ln_beta x) - ln_beta x)) by field.
  apply Rle_trans with 1; [|lra].
  change 1 with (bpow 0); apply bpow_le.
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  omega.
- (* x' <> 0 *)
  assert (Px' : 0 < x').
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
  { assert (0 <= x'); [|lra].
(* Goal: Rlt (Rabs (Rminus (Rmult (Rmult x'' (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) (Rmult (Z2R (Zceil (scaled_mantissa beta fexp1 x))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
    unfold x'.
    apply (Rmult_le_reg_r (bpow (- fexp1 (ln_beta x))));
      [now apply bpow_gt_0|].
(* Goal: generic_format beta fexp2 (Rmult (IZR Z0) y) *)
    rewrite Rmult_0_l.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    unfold round, F2R, canonic_exp; simpl; bpow_simplify.
    change 0 with (Z2R 0); apply Z2R_le.
    apply Zfloor_lub.
    rewrite <- (Rabs_right x); [|now apply Rle_ge; apply Rlt_le].
    rewrite scaled_mantissa_abs.
    apply Rabs_pos. }
  assert (Hx' : x' <= bpow (ln_beta x) - ulp beta fexp1 x).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
  { apply (Rplus_le_reg_r (ulp beta fexp1 x)); ring_simplify.
    rewrite <- ulp_DN.
    - change (round _ _ _ _) with x'.
(* Goal: Rle (Rplus a (ulp beta fexp1 a)) (Fcore_Raux.bpow beta (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) *)
      apply id_p_ulp_le_bpow.
      + exact Px'.
      + change x' with (round beta fexp1 Zfloor x).
        now apply generic_format_round; [|apply valid_rnd_DN].
      + apply Rle_lt_trans with x.
(* Goal: Rle (IZR Z0) rd *)
        * now apply round_DN_pt.
        * rewrite <- (Rabs_right x) at 1; [|now apply Rle_ge; apply Rlt_le].
(* Goal: Rlt (Rabs (sqrt x)) (Fcore_Raux.bpow beta (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) *)
          apply bpow_ln_beta_gt.
(* Goal: Valid_exp fexp1 *)
    - exact Vfexp1.
    - exact Px'. }
  fold (canonic_exp beta fexp2 x); fold (ulp beta fexp2 x).
  assert (/ 2 * ulp beta fexp1 x <= ulp beta fexp1 x).
  rewrite <- (Rmult_1_l (ulp _ _ _)) at 2.
  apply Rmult_le_compat_r; [|lra].
  apply ulp_ge_0.
  rewrite 2!ulp_neq_0 in Hx2;[|now apply Rgt_not_eq|now apply Rgt_not_eq].
  rewrite ulp_neq_0 in Hx';[|now apply Rgt_not_eq].
  rewrite ulp_neq_0 in H;[|now apply Rgt_not_eq].
(* Goal: forall _ : Rlt (Rplus (Rplus x' (Rmult (Rinv (IZR (Zpos (xO xH)))) u1)) (Rmult (Rinv (IZR (Zpos (xO xH)))) u2)) x, Rlt (Rplus (Rminus (Rplus x' u1) (Rmult (Rinv (IZR (Zpos (xO xH)))) u1)) (Rmult (Rinv (IZR (Zpos (xO xH)))) u2)) x *)
  lra.
Qed.

Lemma double_round_lt_mid_same_place :
  forall (fexp1 fexp2 : Z -> Z),
  Valid_exp fexp1 ->
  forall (choice1 choice2 : Z -> bool),
  forall x,
  0 < x ->
  (fexp2 (ln_beta x) = fexp1 (ln_beta x))%Z ->
  x < midp fexp1 x ->
  double_round_eq fexp1 fexp2 choice1 choice2 x.
Proof.
(* Goal: forall (fexp1 fexp2 : forall _ : Z, Z) (_ : Valid_exp fexp1) (choice1 choice2 : forall _ : Z, bool) (x : R) (_ : Rlt (IZR Z0) x) (_ : @eq Z (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) (_ : Rlt x (midp fexp1 x)), double_round_eq fexp1 fexp2 choice1 choice2 x *)
intros fexp1 fexp2 Vfexp1 choice1 choice2 x Px Hf2f1.
(* Goal: forall _ : Rlt x (midp fexp1 x), double_round_eq fexp1 fexp2 choice1 choice2 x *)
intro Hx'.
assert (Hx : x - round beta fexp1 Zfloor x < / 2 * ulp beta fexp1 x).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ now apply (Rplus_lt_reg_r (round beta fexp1 Zfloor x)); ring_simplify. }
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 x *)
revert Hx.
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
unfold double_round_eq.
(* Goal: forall (_ : forall (_ : @eq Z (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Z.add (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH))) (_ : Rle (Rminus (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))) x), double_round_eq fexp1 fexp2 choice1 choice2 x) (_ : forall (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : and (Rle (Rminus (midp fexp1 x) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))) x) (Rlt x (midp fexp1 x))), double_round_eq fexp1 fexp2 choice1 choice2 x) (_ : forall (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : @eq R x (midp fexp1 x)), double_round_eq fexp1 fexp2 choice1 choice2 x) (_ : forall (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : and (Rlt (midp fexp1 x) x) (Rle x (Rplus (midp fexp1 x) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))))), double_round_eq fexp1 fexp2 choice1 choice2 x), double_round_eq fexp1 fexp2 choice1 choice2 x *)
set (x' := round beta fexp1 Zfloor x).
(* Goal: forall _ : Rlt x (Rminus (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Rmult (Rinv (IZR (Zpos (xO xH)))) u2)), @eq R (round beta fexp1 (Znearest choice1) x'') (round beta fexp1 (Znearest choice1) x) *)
intro Hx.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)) (round beta fexp1 (Znearest choice1) x) *)
assert (Pxx' : 0 <= x - x').
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ apply Rle_0_minus.
(* Goal: Rle (IZR Z0) rd *)
  apply round_DN_pt.
  exact Vfexp1. }
assert (H : Rabs (x * bpow (- fexp1 (ln_beta x)) -
                  Z2R (Zfloor (x * bpow (- fexp1 (ln_beta x))))) < / 2).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ apply (Rmult_lt_reg_r (bpow (fexp1 (ln_beta x)))); [now apply bpow_gt_0|].
(* Goal: Rlt (Rmult (Rabs (Rminus (Z2R (Zceil (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
  unfold scaled_mantissa, canonic_exp in Hx.
  rewrite <- (Rabs_right (bpow (fexp1 _))) at 1;
    [|now apply Rle_ge; apply bpow_ge_0].
  rewrite <- Rabs_mult.
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rmult (Rminus (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))))) *)
  rewrite Rmult_minus_distr_r.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
  bpow_simplify.
(* Goal: Rlt (Rabs (Rminus (Rmult (Z2R (Zceil (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) x)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
  apply Rabs_lt.
  change (Z2R _ * _) with x'.
(* Goal: and (Rle (Fcore_Raux.bpow beta (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH))) x'') (Rlt x'' (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) *)
  split.
  - apply Rlt_le_trans with 0; [|exact Pxx'].
    rewrite <- Ropp_0.
(* Goal: Rlt (Ropp (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Ropp (IZR Z0)) *)
    apply Ropp_lt_contravar.
    rewrite <- (Rmult_0_r (/ 2)).
(* Goal: Rlt (Rmult (Rinv (IZR (Zpos (xO xH)))) (IZR Z0)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus u1 u2)) *)
    apply Rmult_lt_compat_l; [lra|].
(* Goal: Rlt (IZR Z0) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) *)
    apply bpow_gt_0.
  - rewrite ulp_neq_0 in Hx;try apply Rgt_not_eq; assumption. }
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)) (round beta fexp1 (Znearest choice1) x) *)
unfold round at 2.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (@F2R beta (Float beta (Znearest choice2 (scaled_mantissa beta fexp2 x)) (canonic_exp beta fexp2 x)))) (round beta fexp1 (Znearest choice1) x) *)
unfold F2R, scaled_mantissa, canonic_exp; simpl.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (Rmult (Z2R (Znearest choice2 (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (round beta fexp1 (Znearest choice1) x) *)
rewrite Hf2f1.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (Rmult (Z2R (Znearest choice2 (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (round beta fexp1 (Znearest choice1) x) *)
rewrite (Znearest_imp _ _ (Zfloor (scaled_mantissa beta fexp1 x))).
- rewrite round_generic.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) (IZR Z0) *)
  + unfold round, F2R, scaled_mantissa, canonic_exp; simpl.
    now rewrite (Znearest_imp _ _ (Zfloor (x * bpow (- fexp1 (ln_beta x))))).
  + now apply valid_rnd_N.
  + fold (canonic_exp beta fexp1 x).
    change (Z2R _ * bpow _) with (round beta fexp1 Zfloor x).
(* Goal: generic_format beta fexp1 (round beta fexp1 Zfloor (sqrt x)) *)
    apply generic_format_round.
(* Goal: Valid_exp fexp1 *)
    exact Vfexp1.
(* Goal: Valid_rnd Zfloor *)
    now apply valid_rnd_DN.
- now unfold scaled_mantissa, canonic_exp.
Qed.

Lemma double_round_lt_mid :
  forall (fexp1 fexp2 : Z -> Z),
  Valid_exp fexp1 -> Valid_exp fexp2 ->
  forall (choice1 choice2 : Z -> bool),
  forall x,
  0 < x ->
  (fexp2 (ln_beta x) <= fexp1 (ln_beta x))%Z ->
  (fexp1 (ln_beta x) <= ln_beta x)%Z ->
  x < midp fexp1 x ->
  ((fexp2 (ln_beta x) <= fexp1 (ln_beta x) - 1)%Z ->
   x < midp fexp1 x - / 2 * ulp beta fexp2 x) ->
  double_round_eq fexp1 fexp2 choice1 choice2 x.
Proof.
(* Goal: forall (fexp1 fexp2 : forall _ : Z, Z) (_ : Valid_exp fexp1) (_ : Valid_exp fexp2) (choice1 choice2 : forall _ : Z, bool) (x : R) (_ : Rlt (IZR Z0) x) (_ : Z.le (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : Rlt (midp' fexp1 x) x) (_ : forall _ : Z.le (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Zpos xH)), Rlt (Rplus (midp' fexp1 x) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))) x), double_round_eq fexp1 fexp2 choice1 choice2 x *)
intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 x Px Hf2f1 Hf1 Hx Hx'.
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 x *)
destruct (Zle_or_lt (fexp1 (ln_beta x)) (fexp2 (ln_beta x))) as [Hf2'|Hf2'].
- (* fexp1 (ln_beta x) <= fexp2 (ln_beta x) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 x *)
  assert (Hf2'' : (fexp2 (ln_beta x) = fexp1 (ln_beta x) :> Z)%Z); [omega|].
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 x *)
  now apply double_round_lt_mid_same_place.
- (* fexp2 (ln_beta x) < fexp1 (ln_beta x) *)
  assert (Hf2'' : (fexp2 (ln_beta x) <= fexp1 (ln_beta x) - 1)%Z); [omega|].
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 x *)
  generalize (Hx' Hf2''); intro Hx''.
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 x *)
  now apply double_round_lt_mid_further_place.
Qed.

Lemma double_round_gt_mid_further_place' :
  forall (fexp1 fexp2 : Z -> Z),
  Valid_exp fexp1 -> Valid_exp fexp2 ->
  forall (choice1 choice2 : Z -> bool),
  forall x,
  0 < x ->
  (fexp2 (ln_beta x) <= fexp1 (ln_beta x) - 1)%Z ->
  round beta fexp2 (Znearest choice2) x < bpow (ln_beta x) ->
  midp' fexp1 x + / 2 * ulp beta fexp2 x < x ->
  double_round_eq fexp1 fexp2 choice1 choice2 x.
Proof.
(* Goal: forall (fexp1 fexp2 : forall _ : Z, Z) (_ : Valid_exp fexp1) (_ : Valid_exp fexp2) (choice1 choice2 : forall _ : Z, bool) (x : R) (_ : Rlt (IZR Z0) x) (_ : Z.le (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Zpos xH))) (_ : Rlt (round beta fexp2 (Znearest choice2) x) (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) (_ : Rlt (Rplus (midp' fexp1 x) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))) x), double_round_eq fexp1 fexp2 choice1 choice2 x *)
intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 x Px Hf2f1.
(* Goal: forall (_ : Rlt (round beta fexp2 (Znearest choice2) x) (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) (_ : Rlt (Rplus (midp' fexp1 x) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))) x), double_round_eq fexp1 fexp2 choice1 choice2 x *)
intros Hx1 Hx2'.
assert (Hx2 : round beta fexp1 Zceil x - x
              < / 2 * (ulp beta fexp1 x - ulp beta fexp2 x)).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ apply (Rplus_lt_reg_r (- / 2 * ulp beta fexp1 x + x
                         + / 2 * ulp beta fexp2 x)); ring_simplify.
  now unfold midp' in Hx2'. }
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 x *)
revert Hx1 Hx2.
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
unfold double_round_eq.
(* Goal: forall (_ : Rlt (round beta fexp2 (Znearest choice2) x) (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) (_ : Rlt (Rminus (round beta fexp1 Zceil x) x) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (ulp beta fexp1 x) (ulp beta fexp2 x)))), @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)) (round beta fexp1 (Znearest choice1) x) *)
set (x' := round beta fexp1 Zceil x).
(* Goal: forall _ : Rlt x (Rminus (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))), @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)) (round beta fexp1 (Znearest choice1) x) *)
set (x'' := round beta fexp2 (Znearest choice2) x).
(* Goal: forall (_ : Rlt x'' (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) (_ : Rlt (Rminus x' x) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (ulp beta fexp1 x) (ulp beta fexp2 x)))), @eq R (round beta fexp1 (Znearest choice1) x'') (round beta fexp1 (Znearest choice1) x) *)
intros Hx1 Hx2.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) x'') (round beta fexp1 (Znearest choice1) x) *)
assert (Hr1 : Rabs (x'' - x) <= / 2 * bpow (fexp2 (ln_beta x))).
  apply Rle_trans with (/2* ulp beta fexp2 x).
(* Goal: Rle (Rabs (Rminus x'' x)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x)) *)
(* Goal: Rle (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) x'') (round beta fexp1 (Znearest choice1) x) *)
  now unfold x''; apply error_le_half_ulp...
(* Goal: Rle (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) x'') (round beta fexp1 (Znearest choice1) x) *)
  rewrite ulp_neq_0;[now right|now apply Rgt_not_eq].
assert (Px'x : 0 <= x' - x).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ apply Rle_0_minus.
(* Goal: Rle x (Rmult (Z2R (Zceil (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
  apply round_UP_pt.
  exact Vfexp1. }
(* Goal: @eq R (round beta fexp1 (Znearest choice1) x'') (round beta fexp1 (Znearest choice1) x) *)
assert (Hr2 : Rabs (x'' - x') < / 2 * bpow (fexp1 (ln_beta x))).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ replace (x'' - x') with (x'' - x + (x - x')) by ring.
(* Goal: Rlt (Rabs (Rplus (Rminus x'' x) (Rminus x x'))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
  apply (Rle_lt_trans _ _ _ (Rabs_triang _ _)).
  replace (/ 2 * _) with (/ 2 * bpow (fexp2 (ln_beta x))
                          + (/ 2 * (bpow (fexp1 (ln_beta x))
                                    - bpow (fexp2 (ln_beta x))))) by ring.
(* Goal: Rlt (Rplus (Rabs (Rminus x'' x)) (Rabs (Rminus x x'))) (Rplus (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) *)
  apply Rplus_le_lt_compat.
  - exact Hr1.
  - rewrite Rabs_minus_sym.
(* Goal: Rlt (Rabs (Rminus x' x)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) *)
   rewrite 2!ulp_neq_0 in Hx2; try (apply Rgt_not_eq; assumption).
    now rewrite Rabs_right; [|now apply Rle_ge]; apply Hx2. }
(* Goal: @eq R (round beta fexp1 (Znearest choice1) x'') (round beta fexp1 (Znearest choice1) x) *)
destruct (Req_dec x'' 0) as [Zx''|Nzx''].
- (* x'' = 0 *)
  rewrite Zx'' in Hr1 |- *.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (IZR Z0)) (round beta fexp1 (Znearest choice1) x) *)
  rewrite round_0; [|now apply valid_rnd_N].
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) (IZR Z0) *)
  unfold round, F2R, scaled_mantissa, canonic_exp; simpl.
(* Goal: @eq R (IZR Z0) (Rmult (Z2R (Znearest choice1 (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
  rewrite (Znearest_imp _ _ 0); [now simpl; rewrite Rmult_0_l|].
(* Goal: Rlt (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (IZR (Zpos xH)) *)
  apply (Rmult_lt_reg_r (bpow (fexp1 (ln_beta x)))); [now apply bpow_gt_0|].
  rewrite <- (Rabs_right (bpow (fexp1 _))) at 1;
    [|now apply Rle_ge; apply bpow_ge_0].
  rewrite <- Rabs_mult; rewrite Rmult_minus_distr_r.
(* Goal: generic_format beta fexp2 (Rmult (IZR Z0) y) *)
  rewrite Rmult_0_l.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
  bpow_simplify.
(* Goal: Rle (Rabs (Rminus x x'')) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x)) *)
  rewrite Rabs_minus_sym.
(* Goal: Rlt (Rabs (Rminus (IZR Z0) x)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
  apply (Rle_lt_trans _ _ _ Hr1).
(* Goal: Rlt (Rmult (Rinv (IZR (Zpos (xO xH)))) (IZR Z0)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus u1 u2)) *)
  apply Rmult_lt_compat_l; [lra|].
(* Goal: Rlt (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))))) *)
  apply bpow_lt.
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  omega.
- (* x'' <> 0 *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) x'') (round beta fexp1 (Znearest choice1) x) *)
  assert (Lx'' : ln_beta x'' = ln_beta x :> Z).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
  { apply Zle_antisym.
    - apply ln_beta_le_bpow; [exact Nzx''|].
(* Goal: Rlt (Rabs x'') (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) *)
      rewrite Rabs_right; [exact Hx1|apply Rle_ge].
(* Goal: Rle (IZR Z0) x'' *)
      apply round_ge_generic.
      + exact Vfexp2.
      + now apply valid_rnd_N.
      + apply generic_format_0.
      + now apply Rlt_le.
    - unfold x'' in Nzx'' |- *.
      now apply ln_beta_round_ge; [|apply valid_rnd_N|]. }
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) (IZR Z0) *)
  unfold round, F2R, scaled_mantissa, canonic_exp; simpl.
(* Goal: @eq R (Rmult (Z2R (Znearest choice1 (Rmult x'' (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x'' (Fcore_Raux.ln_beta beta x'')))))))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x'' (Fcore_Raux.ln_beta beta x''))))) (Rmult (Z2R (Znearest choice1 (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
  rewrite Lx''.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (Rmult (Z2R (Znearest choice2 (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (round beta fexp1 (Znearest choice1) x) *)
  rewrite (Znearest_imp _ _ (Zceil (scaled_mantissa beta fexp1 x))).
  + rewrite (Znearest_imp _ _ (Zceil (scaled_mantissa beta fexp1 x)));
    [reflexivity|].
(* Goal: Rlt (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (IZR (Zpos xH)) *)
    apply (Rmult_lt_reg_r (bpow (fexp1 (ln_beta x)))); [now apply bpow_gt_0|].
    rewrite <- (Rabs_right (bpow (fexp1 _))) at 1;
      [|now apply Rle_ge; apply bpow_ge_0].
    rewrite <- Rabs_mult.
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rmult (Rminus (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))))) *)
    rewrite Rmult_minus_distr_r.
(* Goal: Rlt (Rabs (Rminus (Rmult (Rmult x'' (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) (Rmult (Z2R (Zceil (scaled_mantissa beta fexp1 x))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
    fold x'.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    bpow_simplify.
(* Goal: Rle (Rabs (Rminus x x'')) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x)) *)
    rewrite Rabs_minus_sym.
(* Goal: Rlt (Rabs (Rminus (Rmult (Z2R (Zceil (scaled_mantissa beta fexp1 x))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) x)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
    rewrite Rabs_right; [|now apply Rle_ge].
(* Goal: Rlt (Rminus (Rmult (Z2R (Zceil (scaled_mantissa beta fexp1 x))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) x) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
    apply (Rlt_le_trans _ _ _ Hx2).
(* Goal: Rle (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rdiv (IZR (Zpos (xO xH))) (IZR (Zpos (xI xH))))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (IZR (Zpos xH)) (Fcore_Raux.bpow beta (Z.sub (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))))) *)
    apply Rmult_le_compat_l; [lra|].
(* Goal: Rle (Rminus (ulp beta fexp1 x) (ulp beta fexp2 x)) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) *)
    generalize (bpow_ge_0 beta (fexp2 (ln_beta x))).
(* Goal: forall _ : Rle (IZR Z0) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))), Rle (Rminus (ulp beta fexp1 x) (ulp beta fexp2 x)) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) *)
    rewrite 2!ulp_neq_0; try (apply Rgt_not_eq; assumption).
(* Goal: forall _ : Rlt (Rplus (Rplus x' (Rmult (Rinv (IZR (Zpos (xO xH)))) u1)) (Rmult (Rinv (IZR (Zpos (xO xH)))) u2)) x, Rlt (Rplus (Rminus (Rplus x' u1) (Rmult (Rinv (IZR (Zpos (xO xH)))) u1)) (Rmult (Rinv (IZR (Zpos (xO xH)))) u2)) x *)
    unfold canonic_exp; lra.
(* Goal: Rlt (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (IZR (Zpos xH)) *)
  + apply (Rmult_lt_reg_r (bpow (fexp1 (ln_beta x)))); [now apply bpow_gt_0|].
    rewrite <- (Rabs_right (bpow (fexp1 _))) at 1;
      [|now apply Rle_ge; apply bpow_ge_0].
    rewrite <- Rabs_mult.
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rmult (Rminus (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))))) *)
    rewrite Rmult_minus_distr_r.
(* Goal: Rlt (Rabs (Rminus (Rmult (Rmult x'' (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) (Rmult (Z2R (Zceil (scaled_mantissa beta fexp1 x))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
    fold x'.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    now bpow_simplify.
Qed.

Lemma double_round_gt_mid_further_place :
  forall (fexp1 fexp2 : Z -> Z),
  Valid_exp fexp1 -> Valid_exp fexp2 ->
  forall (choice1 choice2 : Z -> bool),
  forall x,
  0 < x ->
  (fexp2 (ln_beta x) <= fexp1 (ln_beta x) - 1)%Z ->
  (fexp1 (ln_beta x) <= ln_beta x)%Z ->
  midp' fexp1 x + / 2 * ulp beta fexp2 x < x ->
  double_round_eq fexp1 fexp2 choice1 choice2 x.
Proof.
(* Goal: forall (fexp1 fexp2 : forall _ : Z, Z) (_ : Valid_exp fexp1) (_ : Valid_exp fexp2) (choice1 choice2 : forall _ : Z, bool) (x : R) (_ : Rlt (IZR Z0) x) (_ : Z.le (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Zpos xH))) (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : Rlt (Rplus (midp' fexp1 x) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))) x), double_round_eq fexp1 fexp2 choice1 choice2 x *)
intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 x Px Hf2f1 Hf1 Hx2'.
assert (Hx2 : round beta fexp1 Zceil x - x
              < / 2 * (ulp beta fexp1 x - ulp beta fexp2 x)).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ apply (Rplus_lt_reg_r (- / 2 * ulp beta fexp1 x + x
                         + / 2 * ulp beta fexp2 x)); ring_simplify.
  now unfold midp' in Hx2'. }
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 x *)
revert Hx2.
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
unfold double_round_eq.
(* Goal: forall (_ : forall (_ : @eq Z (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Z.add (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH))) (_ : Rle (Rminus (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))) x), double_round_eq fexp1 fexp2 choice1 choice2 x) (_ : forall (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : and (Rle (Rminus (midp fexp1 x) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))) x) (Rlt x (midp fexp1 x))), double_round_eq fexp1 fexp2 choice1 choice2 x) (_ : forall (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : @eq R x (midp fexp1 x)), double_round_eq fexp1 fexp2 choice1 choice2 x) (_ : forall (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : and (Rlt (midp fexp1 x) x) (Rle x (Rplus (midp fexp1 x) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))))), double_round_eq fexp1 fexp2 choice1 choice2 x), double_round_eq fexp1 fexp2 choice1 choice2 x *)
set (x' := round beta fexp1 Zfloor x).
(* Goal: forall _ : Rlt (Rminus (round beta fexp1 Zceil x) x) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (ulp beta fexp1 x) (ulp beta fexp2 x))), @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)) (round beta fexp1 (Znearest choice1) x) *)
intro Hx2.
(* Goal: forall _ : Rlt x (Rminus (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))), @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)) (round beta fexp1 (Znearest choice1) x) *)
set (x'' := round beta fexp2 (Znearest choice2) x).
destruct (Rlt_or_le x'' (bpow (ln_beta x))) as [Hx''|Hx''];
  [now apply double_round_gt_mid_further_place'|].
(* bpow (ln_beta x) <= x'' *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) x'') (round beta fexp1 (Znearest choice1) x) *)
assert (Hx''pow : x'' = bpow (ln_beta x)).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ assert (H'x'' : x'' < bpow (ln_beta x) + / 2 * ulp beta fexp2 x).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
  { apply Rle_lt_trans with (x + / 2 * ulp beta fexp2 x).
    - apply (Rplus_le_reg_r (- x)); ring_simplify.
(* Goal: Rle (Rminus x'' x) (Rmult (Rinv (IZR (Zpos (xO xH)))) u2) *)
      apply Rabs_le_inv.
(* Goal: Rle (Rabs (Rminus x'' x)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x)) *)
      apply error_le_half_ulp.
(* Goal: Valid_exp fexp2 *)
      exact Vfexp2.
    - apply Rplus_lt_compat_r.
      rewrite <- Rabs_right at 1; [|now apply Rle_ge; apply Rlt_le].
      apply bpow_ln_beta_gt. }
(* Goal: @eq R x'' (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) *)
  apply Rle_antisym; [|exact Hx''].
(* Goal: Rle x'' (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) *)
  unfold x'', round, F2R, scaled_mantissa, canonic_exp; simpl.
  apply (Rmult_le_reg_r (bpow (- fexp2 (ln_beta x)))); [now apply bpow_gt_0|].
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
  bpow_simplify.
  rewrite <- (Z2R_Zpower _ (_ - _)); [|omega].
(* Goal: Rle (Z2R (Zceil (Rmult (Rminus x y) (Fcore_Raux.bpow beta (Z.opp (fexp (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH)))))))) (Z2R (Z.pow (radix_val beta) (Z.sub (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (fexp (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH)))) (Zpos xH)))) *)
  apply Z2R_le.
(* Goal: Z.le (Znearest choice2 (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Z.pow (radix_val beta) (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
  apply Zlt_succ_le; unfold Z.succ.
(* Goal: Z.lt (Znearest choice2 (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Z.add (Z.pow (radix_val beta) (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) (Zpos xH)) *)
  apply lt_Z2R.
(* Goal: Rlt (Z2R (Znearest choice2 (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Z2R (Z.add (Z.pow (radix_val beta) (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) (Zpos xH))) *)
  rewrite Z2R_plus; rewrite Z2R_Zpower; [|omega].
(* Goal: Rlt (Z2R (Znearest choice2 (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Rplus (Fcore_Raux.bpow beta (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) (Z2R (Zpos xH))) *)
  apply (Rmult_lt_reg_r (bpow (fexp2 (ln_beta x)))); [now apply bpow_gt_0|].
(* Goal: Rlt (Rmult (Z2R (Znearest choice2 (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) (Rmult (Rplus (Fcore_Raux.bpow beta (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) (Z2R (Zpos xH))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
  rewrite Rmult_plus_distr_r; rewrite Rmult_1_l.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
  bpow_simplify.
(* Goal: Rlt (Rmult (Z2R (Znearest choice2 (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) (Rplus (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
  apply (Rlt_le_trans _ _ _ H'x'').
(* Goal: Rle (Rplus (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))) (Rplus (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH)))) *)
  apply Rplus_le_compat_l.
  rewrite <- (Rmult_1_l (Fcore_Raux.bpow _ _)).
(* Goal: Rlt y (ulp beta fexp x) *)
  rewrite ulp_neq_0;[idtac|now apply Rgt_not_eq].
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (Z.opp (Zpos xH))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))) *)
  apply Rmult_le_compat_r; [now apply bpow_ge_0|].
  lra. }
assert (Hr : Rabs (x - x'') < / 2 * ulp beta fexp1 x).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ apply Rle_lt_trans with (/ 2 * ulp beta fexp2 x).
  - rewrite Rabs_minus_sym.
(* Goal: Rle (Rabs (Rminus x'' x)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x)) *)
    apply error_le_half_ulp.
(* Goal: Valid_exp fexp2 *)
    exact Vfexp2.
  - apply Rmult_lt_compat_l; [lra|].
(* Goal: Rlt (ulp beta fexp2 x) (ulp beta fexp1 x) *)
    rewrite 2!ulp_neq_0; try now apply Rgt_not_eq.
(* Goal: Rlt (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))))) *)
    unfold canonic_exp; apply bpow_lt.
    omega. }
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) (IZR Z0) *)
unfold round, F2R, scaled_mantissa, canonic_exp; simpl.
assert (Hf : (0 <= ln_beta x - fexp1 (ln_beta x''))%Z).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ rewrite Hx''pow.
(* Goal: @eq R (Rmult (Z2R (Znearest choice1 (Rmult (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Fcore_Raux.ln_beta beta (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))))))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Fcore_Raux.ln_beta beta (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (IZR Z0) *)
  rewrite ln_beta_bpow.
  assert (fexp1 (ln_beta x + 1) <= ln_beta x)%Z; [|omega].
  destruct (Zle_or_lt (ln_beta x) (fexp1 (ln_beta x))) as [Hle|Hlt];
    [|now apply Vfexp1].
  assert (H : (ln_beta x = fexp1 (ln_beta x) :> Z)%Z);
    [now apply Zle_antisym|].
(* Goal: Z.le (fexp1 (Z.add (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) *)
  rewrite H.
  now apply Vfexp1. }
rewrite (Znearest_imp _ _ (beta ^ (ln_beta x - fexp1 (ln_beta x'')))%Z).
- rewrite (Znearest_imp _ _ (beta ^ (ln_beta x - fexp1 (ln_beta x)))%Z).
  + rewrite Z2R_Zpower; [|exact Hf].
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Z2R (Z.pow (radix_val beta) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    rewrite Z2R_Zpower; [|omega].
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    now bpow_simplify.
  + rewrite Z2R_Zpower; [|omega].
(* Goal: Rlt (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (IZR (Zpos xH)) *)
    apply (Rmult_lt_reg_r (bpow (fexp1 (ln_beta x)))); [now apply bpow_gt_0|].
    rewrite <- (Rabs_right (bpow (fexp1 _))) at 1;
      [|now apply Rle_ge; apply bpow_ge_0].
    rewrite <- Rabs_mult.
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rmult (Rminus (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))))) *)
    rewrite Rmult_minus_distr_r.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    bpow_simplify.
(* Goal: Rlt (Rabs (Rminus x (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
   rewrite ulp_neq_0 in Hr;[idtac|now apply Rgt_not_eq].
    rewrite <- Hx''pow; exact Hr.
- rewrite Z2R_Zpower; [|exact Hf].
(* Goal: Rlt (Rabs (Rminus (Rmult x'' (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x'' (Fcore_Raux.ln_beta beta x'')))))) (Fcore_Raux.bpow beta (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (fexp1 (ln_beta_val beta x'' (Fcore_Raux.ln_beta beta x''))))))) (Rinv (IZR (Zpos (xO xH)))) *)
  apply (Rmult_lt_reg_r (bpow (fexp1 (ln_beta x'')))); [now apply bpow_gt_0|].
  rewrite <- (Rabs_right (bpow (fexp1 _))) at 1;
    [|now apply Rle_ge; apply bpow_ge_0].
  rewrite <- Rabs_mult.
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rmult (Rminus (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))))) *)
  rewrite Rmult_minus_distr_r.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
  bpow_simplify.
(* Goal: Rlt (Rabs (Rminus x'' (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x'' (Fcore_Raux.ln_beta beta x''))))) *)
  rewrite Rminus_diag_eq; [|exact Hx''pow].
(* Goal: Rlt (Rabs (IZR Z0)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x'' (Fcore_Raux.ln_beta beta x''))))) *)
  rewrite Rabs_R0.
  rewrite <- (Rmult_0_r (/ 2)).
(* Goal: Rlt (Rmult (Rinv (IZR (Zpos (xO xH)))) (IZR Z0)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x'' (Fcore_Raux.ln_beta beta x''))))) *)
  apply Rmult_lt_compat_l; [lra|apply bpow_gt_0].
Qed.

Lemma double_round_gt_mid_same_place :
  forall (fexp1 fexp2 : Z -> Z),
  Valid_exp fexp1 ->
  forall (choice1 choice2 : Z -> bool),
  forall x,
  0 < x ->
  (fexp2 (ln_beta x) = fexp1 (ln_beta x))%Z ->
  midp' fexp1 x < x ->
  double_round_eq fexp1 fexp2 choice1 choice2 x.
Proof.
(* Goal: forall (fexp1 fexp2 : forall _ : Z, Z) (_ : Valid_exp fexp1) (choice1 choice2 : forall _ : Z, bool) (x : R) (_ : Rlt (IZR Z0) x) (_ : @eq Z (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) (_ : Rlt (midp' fexp1 x) x), double_round_eq fexp1 fexp2 choice1 choice2 x *)
intros fexp1 fexp2 Vfexp1 choice1 choice2 x Px Hf2f1 Hx'.
assert (Hx : round beta fexp1 Zceil x - x < / 2 * ulp beta fexp1 x).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ apply (Rplus_lt_reg_r (- / 2 * ulp beta fexp1 x + x)); ring_simplify.
  now unfold midp' in Hx'. }
assert (H : Rabs (Z2R (Zceil (x * bpow (- fexp1 (ln_beta x))))
                  - x * bpow (- fexp1 (ln_beta x))) < / 2).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ apply (Rmult_lt_reg_r (bpow (fexp1 (ln_beta x)))); [now apply bpow_gt_0|].
(* Goal: Rlt (Rmult (Rabs (Rminus (Z2R (Zceil (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
  unfold scaled_mantissa, canonic_exp in Hx.
  rewrite <- (Rabs_right (bpow (fexp1 _))) at 1;
    [|now apply Rle_ge; apply bpow_ge_0].
  rewrite <- Rabs_mult.
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rmult (Rminus (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))))) *)
  rewrite Rmult_minus_distr_r.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
  bpow_simplify.
(* Goal: Rlt (Rabs (Rminus (Rmult (Z2R (Zceil (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) x)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
  apply Rabs_lt.
(* Goal: and (Rle (Fcore_Raux.bpow beta (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH))) x'') (Rlt x'' (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) *)
  split.
  - apply Rlt_le_trans with 0.
    + rewrite <- Ropp_0; apply Ropp_lt_contravar.
      rewrite <- (Rmult_0_r (/ 2)).
(* Goal: Rlt (Rmult (Rinv (IZR (Zpos (xO xH)))) (IZR Z0)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus u1 u2)) *)
      apply Rmult_lt_compat_l; [lra|].
(* Goal: Rlt (IZR Z0) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) *)
      apply bpow_gt_0.
(* Goal: Rle (IZR Z0) (Rminus (Rmult (Z2R (Zceil (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) x) *)
    + apply Rle_0_minus.
(* Goal: Rle x (Rmult (Z2R (Zceil (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
      apply round_UP_pt.
(* Goal: Valid_exp fexp1 *)
      exact Vfexp1.
  -  rewrite ulp_neq_0 in Hx;[exact Hx|now apply Rgt_not_eq]. }
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 x *)
unfold double_round_eq, round at 2.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (@F2R beta (Float beta (Znearest choice2 (scaled_mantissa beta fexp2 x)) (canonic_exp beta fexp2 x)))) (round beta fexp1 (Znearest choice1) x) *)
unfold F2R, scaled_mantissa, canonic_exp; simpl.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (Rmult (Z2R (Znearest choice2 (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (round beta fexp1 (Znearest choice1) x) *)
rewrite Hf2f1.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (Rmult (Z2R (Znearest choice2 (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (round beta fexp1 (Znearest choice1) x) *)
rewrite (Znearest_imp _ _ (Zceil (scaled_mantissa beta fexp1 x))).
- rewrite round_generic.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) (IZR Z0) *)
  + unfold round, F2R, scaled_mantissa, canonic_exp; simpl.
    now rewrite (Znearest_imp _ _ (Zceil (x * bpow (- fexp1 (ln_beta x)))));
      [|rewrite Rabs_minus_sym].
  + now apply valid_rnd_N.
  + fold (canonic_exp beta fexp1 x).
    change (Z2R _ * bpow _) with (round beta fexp1 Zceil x).
(* Goal: generic_format beta fexp1 (round beta fexp1 Zfloor (sqrt x)) *)
    apply generic_format_round.
(* Goal: Valid_exp fexp1 *)
    exact Vfexp1.
(* Goal: Valid_rnd Zceil *)
    now apply valid_rnd_UP.
- now rewrite Rabs_minus_sym.
Qed.

Lemma double_round_gt_mid :
  forall (fexp1 fexp2 : Z -> Z),
  Valid_exp fexp1 -> Valid_exp fexp2 ->
  forall (choice1 choice2 : Z -> bool),
  forall x,
  0 < x ->
  (fexp2 (ln_beta x) <= fexp1 (ln_beta x))%Z ->
  (fexp1 (ln_beta x) <= ln_beta x)%Z ->
  midp' fexp1 x < x ->
  ((fexp2 (ln_beta x) <= fexp1 (ln_beta x) - 1)%Z ->
   midp' fexp1 x + / 2 * ulp beta fexp2 x < x) ->
  double_round_eq fexp1 fexp2 choice1 choice2 x.
Proof.
(* Goal: forall (fexp1 fexp2 : forall _ : Z, Z) (_ : Valid_exp fexp1) (_ : Valid_exp fexp2) (choice1 choice2 : forall _ : Z, bool) (x : R) (_ : Rlt (IZR Z0) x) (_ : Z.le (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : Rlt (midp' fexp1 x) x) (_ : forall _ : Z.le (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Zpos xH)), Rlt (Rplus (midp' fexp1 x) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))) x), double_round_eq fexp1 fexp2 choice1 choice2 x *)
intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 x Px Hf2f1 Hf1 Hx Hx'.
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 x *)
destruct (Zle_or_lt (fexp1 (ln_beta x)) (fexp2 (ln_beta x))) as [Hf2'|Hf2'].
- (* fexp1 (ln_beta x) <= fexp2 (ln_beta x) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 x *)
  assert (Hf2'' : (fexp2 (ln_beta x) = fexp1 (ln_beta x) :> Z)%Z); [omega|].
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 x *)
  now apply double_round_gt_mid_same_place.
- (* fexp2 (ln_beta x) < fexp1 (ln_beta x) *)
  assert (Hf2'' : (fexp2 (ln_beta x) <= fexp1 (ln_beta x) - 1)%Z); [omega|].
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 x *)
  generalize (Hx' Hf2''); intro Hx''.
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 x *)
  now apply double_round_gt_mid_further_place.
Qed.

Section Double_round_mult.

Lemma ln_beta_mult_disj :
  forall x y,
  x <> 0 -> y <> 0 ->
  ((ln_beta (x * y) = (ln_beta x + ln_beta y - 1)%Z :> Z)
   \/ (ln_beta (x * y) = (ln_beta x + ln_beta y)%Z :> Z)).
Proof.
(* Goal: forall (x y : R) (_ : not (@eq R x (IZR Z0))) (_ : not (@eq R y (IZR Z0))), or (@eq Z (ln_beta_val beta (Rmult x y) (Fcore_Raux.ln_beta beta (Rmult x y))) (Z.sub (Z.add (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (ln_beta_val beta y (Fcore_Raux.ln_beta beta y))) (Zpos xH))) (@eq Z (ln_beta_val beta (Rmult x y) (Fcore_Raux.ln_beta beta (Rmult x y))) (Z.add (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (ln_beta_val beta y (Fcore_Raux.ln_beta beta y)))) *)
intros x y Zx Zy.
(* Goal: or (@eq Z (ln_beta_val beta (Rmult x y) (Fcore_Raux.ln_beta beta (Rmult x y))) (Z.sub (Z.add (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (ln_beta_val beta y (Fcore_Raux.ln_beta beta y))) (Zpos xH))) (@eq Z (ln_beta_val beta (Rmult x y) (Fcore_Raux.ln_beta beta (Rmult x y))) (Z.add (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (ln_beta_val beta y (Fcore_Raux.ln_beta beta y)))) *)
destruct (ln_beta_mult beta x y Zx Zy).
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
omega.
Qed.

Definition double_round_mult_hyp fexp1 fexp2 :=
  (forall ex ey, (fexp2 (ex + ey) <= fexp1 ex + fexp1 ey)%Z)
  /\ (forall ex ey, (fexp2 (ex + ey - 1) <= fexp1 ex + fexp1 ey)%Z).

Lemma double_round_mult_aux :
  forall (fexp1 fexp2 : Z -> Z),
  double_round_mult_hyp fexp1 fexp2 ->
  forall x y,
  generic_format beta fexp1 x -> generic_format beta fexp1 y ->
  generic_format beta fexp2 (x * y).
Proof.
(* Goal: forall (fexp1 fexp2 : forall _ : Z, Z) (_ : double_round_mult_hyp fexp1 fexp2) (x y : R) (_ : generic_format beta fexp1 x) (_ : generic_format beta fexp1 y), @eq R (round beta fexp1 rnd (round beta fexp2 rnd (Rmult x y))) (round beta fexp1 rnd (Rmult x y)) *)
intros fexp1 fexp2 Hfexp x y Fx Fy.
(* Goal: generic_format beta fexp2 (Rmult x y) *)
destruct (Req_dec x 0) as [Zx|Zx].
- (* x = 0 *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rdiv x y))) (round beta fexp1 (Znearest choice1) (Rdiv x y)) *)
  rewrite Zx.
(* Goal: generic_format beta fexp2 (Rmult (IZR Z0) y) *)
  rewrite Rmult_0_l.
(* Goal: generic_format beta fexp1 (IZR Z0) *)
  now apply generic_format_0.
- (* x <> 0 *)
(* Goal: generic_format beta fexp2 (Rmult x y) *)
  destruct (Req_dec y 0) as [Zy|Zy].
  + (* y = 0 *)
(* Goal: generic_format beta fexp2 (Rmult x y) *)
    rewrite Zy.
(* Goal: generic_format beta fexp2 (Rmult x (IZR Z0)) *)
    rewrite Rmult_0_r.
(* Goal: generic_format beta fexp1 (IZR Z0) *)
    now apply generic_format_0.
  + (* y <> 0 *)
(* Goal: generic_format beta fexp2 (Rplus x y) *)
    revert Fx Fy.
(* Goal: forall (_ : generic_format beta fexp1 x) (_ : generic_format beta fexp1 y), generic_format beta fexp2 (Rmult x y) *)
    unfold generic_format.
(* Goal: Rle (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (Fcore_Raux.bpow beta (canonic_exp beta fexp1 (Rminus x y))) (Fcore_Raux.bpow beta (canonic_exp beta fexp2 (Rminus x y))))) *)
    unfold canonic_exp.
(* Goal: forall (_ : @eq R x (Rmult (Z2R (Ztrunc (scaled_mantissa beta fexp1 x))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (_ : @eq R y (Rmult (Z2R (Ztrunc (scaled_mantissa beta fexp1 y))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta y (Fcore_Raux.ln_beta beta y)))))), generic_format beta fexp2 (Rplus x y) *)
    set (mx := Ztrunc (scaled_mantissa beta fexp1 x)).
(* Goal: forall (_ : @eq R x (Rmult (Z2R mx) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (_ : @eq R y (Rmult (Z2R (Ztrunc (scaled_mantissa beta fexp1 y))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta y (Fcore_Raux.ln_beta beta y)))))), generic_format beta fexp2 (Rplus x y) *)
    set (my := Ztrunc (scaled_mantissa beta fexp1 y)).
(* Goal: forall (_ : @eq R x (@F2R beta (Float beta mx (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (_ : @eq R y (@F2R beta (Float beta my (fexp1 (ln_beta_val beta y (Fcore_Raux.ln_beta beta y)))))), @eq R (Rmult x y) (@F2R beta (Float beta (Ztrunc (scaled_mantissa beta fexp2 (Rmult x y))) (fexp2 (ln_beta_val beta (Rmult x y) (Fcore_Raux.ln_beta beta (Rmult x y)))))) *)
    unfold F2R; simpl.
(* Goal: forall (_ : @eq R x (Rmult (Z2R mx) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (_ : @eq R y (Rmult (Z2R my) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta y (Fcore_Raux.ln_beta beta y)))))), generic_format beta fexp2 (Rplus x y) *)
    intros Fx Fy.
    set (fxy := Float beta (mx * my) (fexp1 (ln_beta x) + fexp1 (ln_beta y))).
    assert (Hxy : x * y = F2R fxy).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
    { unfold fxy, F2R; simpl.
(* Goal: Rlt x (Fcore_Raux.bpow beta (Z.add (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))))) *)
      rewrite bpow_plus.
(* Goal: @eq R (Rmult (Z2R (Z.mul (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Z.pow (radix_val beta) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
      rewrite Z2R_mult.
(* Goal: @eq R (Rmult x y) (Rmult (Rmult (Z2R mx) (Z2R my)) (Rmult (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta y (Fcore_Raux.ln_beta beta y)))))) *)
      rewrite Fx, Fy at 1.
      ring. }
(* Goal: generic_format beta fexp2 (Rplus x y) *)
    apply generic_format_F2R' with (f := fxy); [now rewrite Hxy|].
(* Goal: forall _ : not (@eq R x (IZR Z0)), Z.le (canonic_exp beta fexp2 x) (@Fexp beta f) *)
    intros _.
(* Goal: Z.le (canonic_exp beta fexp2 (Rmult x y)) (@Fexp beta fxy) *)
    unfold canonic_exp, fxy; simpl.
(* Goal: Z.le (fexp2 (ln_beta_val beta (Rmult x y) (Fcore_Raux.ln_beta beta (Rmult x y)))) (Z.add (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp1 (ln_beta_val beta y (Fcore_Raux.ln_beta beta y)))) *)
    destruct Hfexp as (Hfexp1, Hfexp2).
(* Goal: Z.le (fexp2 (ln_beta_val beta (Rmult x y) (Fcore_Raux.ln_beta beta (Rmult x y)))) (Z.add (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp1 (ln_beta_val beta y (Fcore_Raux.ln_beta beta y)))) *)
    now destruct (ln_beta_mult_disj x y Zx Zy) as [Lxy|Lxy]; rewrite Lxy.
Qed.

Variable rnd : R -> Z.
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
Context { valid_rnd : Valid_rnd rnd }.

Theorem double_round_mult :
  forall (fexp1 fexp2 : Z -> Z),
  double_round_mult_hyp fexp1 fexp2 ->
  forall x y,
  generic_format beta fexp1 x -> generic_format beta fexp1 y ->
  round beta fexp1 rnd (round beta fexp2 rnd (x * y))
  = round beta fexp1 rnd (x * y).
Proof.
(* Goal: forall (fexp1 fexp2 : forall _ : Z, Z) (_ : double_round_mult_hyp fexp1 fexp2) (x y : R) (_ : generic_format beta fexp1 x) (_ : generic_format beta fexp1 y), @eq R (round beta fexp1 rnd (round beta fexp2 rnd (Rmult x y))) (round beta fexp1 rnd (Rmult x y)) *)
intros fexp1 fexp2 Hfexp x y Fx Fy.
assert (Hxy : round beta fexp2 rnd (x * y) = x * y).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ apply round_generic; [assumption|].
  now apply (double_round_mult_aux fexp1 fexp2). }
(* Goal: @eq R (round beta fexp1 rnd (round beta fexp2 rnd (Rmult x y))) (round beta fexp1 rnd (Rmult x y)) *)
now rewrite Hxy at 1.
Qed.

Section Double_round_mult_FLX.

Import Fcore_FLX.

Variable prec : Z.
Variable prec' : Z.

(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
Context { prec_gt_0_ : Prec_gt_0 prec }.
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
Context { prec_gt_0_' : Prec_gt_0 prec' }.

Theorem double_round_mult_FLX :
  (2 * prec <= prec')%Z ->
  forall x y,
  FLX_format beta prec x -> FLX_format beta prec y ->
  round beta (FLX_exp prec) rnd (round beta (FLX_exp prec') rnd (x * y))
  = round beta (FLX_exp prec) rnd (x * y).
Proof.
(* Goal: forall (_ : Z.le (Z.mul (Zpos (xO xH)) prec) prec') (x y : R) (_ : FLX_format beta prec x) (_ : FLX_format beta prec y), @eq R (round beta (FLX_exp prec) rnd (round beta (FLX_exp prec') rnd (Rmult x y))) (round beta (FLX_exp prec) rnd (Rmult x y)) *)
intros Hprec x y Fx Fy.
apply double_round_mult;
  [|now apply generic_format_FLX|now apply generic_format_FLX].
unfold double_round_mult_hyp; split; intros ex ey; unfold FLX_exp;
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
omega.
Qed.

End Double_round_mult_FLX.

Section Double_round_mult_FLT.

Import Fcore_FLX.
Import Fcore_FLT.

Variable emin prec : Z.
Variable emin' prec' : Z.

(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
Context { prec_gt_0_ : Prec_gt_0 prec }.
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
Context { prec_gt_0_' : Prec_gt_0 prec' }.

Theorem double_round_mult_FLT :
  (emin' <= 2 * emin)%Z -> (2 * prec <= prec')%Z ->
  forall x y,
  FLT_format beta emin prec x -> FLT_format beta emin prec y ->
  round beta (FLT_exp emin prec) rnd
        (round beta (FLT_exp emin' prec') rnd (x * y))
  = round beta (FLT_exp emin prec) rnd (x * y).
Proof.
(* Goal: forall (_ : Z.le (Z.add emin' prec') (Z.add (Z.mul (Zpos (xO xH)) emin) prec)) (_ : Z.le (Z.mul (Zpos (xO xH)) prec) prec') (x y : R) (_ : FTZ_format beta emin prec x) (_ : FTZ_format beta emin prec y), @eq R (round beta (FTZ_exp emin prec) rnd (round beta (FTZ_exp emin' prec') rnd (Rmult x y))) (round beta (FTZ_exp emin prec) rnd (Rmult x y)) *)
intros Hemin Hprec x y Fx Fy.
apply double_round_mult;
  [|now apply generic_format_FLT|now apply generic_format_FLT].
unfold double_round_mult_hyp; split; intros ex ey;
unfold FLT_exp;
generalize (Zmax_spec (ex + ey - prec') emin');
generalize (Zmax_spec (ex + ey - 1 - prec') emin');
generalize (Zmax_spec (ex - prec) emin);
generalize (Zmax_spec (ey - prec) emin);
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
omega.
Qed.

End Double_round_mult_FLT.

Section Double_round_mult_FTZ.

Import Fcore_FLX.
Import Fcore_FTZ.

Variable emin prec : Z.
Variable emin' prec' : Z.

(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
Context { prec_gt_0_ : Prec_gt_0 prec }.
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
Context { prec_gt_0_' : Prec_gt_0 prec' }.

Theorem double_round_mult_FTZ :
  (emin' + prec' <= 2 * emin + prec)%Z ->
  (2 * prec <= prec')%Z ->
  forall x y,
  FTZ_format beta emin prec x -> FTZ_format beta emin prec y ->
  round beta (FTZ_exp emin prec) rnd
        (round beta (FTZ_exp emin' prec') rnd (x * y))
  = round beta (FTZ_exp emin prec) rnd (x * y).
Proof.
(* Goal: forall (_ : Z.le (Z.add emin' prec') (Z.add (Z.mul (Zpos (xO xH)) emin) prec)) (_ : Z.le (Z.mul (Zpos (xO xH)) prec) prec') (x y : R) (_ : FTZ_format beta emin prec x) (_ : FTZ_format beta emin prec y), @eq R (round beta (FTZ_exp emin prec) rnd (round beta (FTZ_exp emin' prec') rnd (Rmult x y))) (round beta (FTZ_exp emin prec) rnd (Rmult x y)) *)
intros Hemin Hprec x y Fx Fy.
apply double_round_mult;
  [|now apply generic_format_FTZ|now apply generic_format_FTZ].
unfold double_round_mult_hyp; split; intros ex ey;
unfold FTZ_exp;
unfold Prec_gt_0 in *;
destruct (Z.ltb_spec (ex + ey - prec') emin');
destruct (Z.ltb_spec (ex - prec) emin);
destruct (Z.ltb_spec (ey - prec) emin);
destruct (Z.ltb_spec (ex + ey - 1 - prec') emin');
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
omega.
Qed.

End Double_round_mult_FTZ.

End Double_round_mult.

Section Double_round_plus.

Lemma ln_beta_plus_disj :
  forall x y,
  0 < y -> y <= x ->
  ((ln_beta (x + y) = ln_beta x :> Z)
   \/ (ln_beta (x + y) = (ln_beta x + 1)%Z :> Z)).
Proof.
(* Goal: forall (x y : R) (_ : Rlt (IZR Z0) y) (_ : Rle y x), or (@eq Z (ln_beta_val beta (Rplus x y) (Fcore_Raux.ln_beta beta (Rplus x y))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (@eq Z (ln_beta_val beta (Rplus x y) (Fcore_Raux.ln_beta beta (Rplus x y))) (Z.add (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH))) *)
intros x y Py Hxy.
(* Goal: or (@eq Z (ln_beta_val beta (Rplus x y) (Fcore_Raux.ln_beta beta (Rplus x y))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (@eq Z (ln_beta_val beta (Rplus x y) (Fcore_Raux.ln_beta beta (Rplus x y))) (Z.add (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH))) *)
destruct (ln_beta_plus beta x y Py Hxy).
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
omega.
Qed.

Lemma ln_beta_plus_separated :
  forall fexp : Z -> Z,
  forall x y,
  0 < x -> 0 <= y ->
  generic_format beta fexp x ->
  (ln_beta y <= fexp (ln_beta x))%Z ->
  (ln_beta (x + y) = ln_beta x :> Z).
Proof.
(* Goal: forall (fexp : forall _ : Z, Z) (x y : R) (_ : Rlt (IZR Z0) x) (_ : Rle (IZR Z0) y) (_ : generic_format beta fexp x) (_ : Z.le (ln_beta_val beta y (Fcore_Raux.ln_beta beta y)) (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))), @eq Z (ln_beta_val beta (Rplus x y) (Fcore_Raux.ln_beta beta (Rplus x y))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) *)
intros fexp x y Px Nny Fx Hsep.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rminus x y))) (round beta fexp1 (Znearest choice1) (Rminus x y)) *)
destruct (Req_dec y 0) as [Zy|Nzy].
- (* y = 0 *)
(* Goal: @eq Z (ln_beta_val beta (Rplus x y) (Fcore_Raux.ln_beta beta (Rplus x y))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) *)
  now rewrite Zy; rewrite Rplus_0_r.
- (* y <> 0 *)
(* Goal: @eq Z (ln_beta_val beta (Rplus x y) (Fcore_Raux.ln_beta beta (Rplus x y))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) *)
  apply (ln_beta_plus_eps beta fexp); [assumption|assumption|].
(* Goal: and (Rle (IZR Z0) y) (Rlt y (ulp beta fexp x)) *)
  split; [assumption|].
(* Goal: Rlt y (ulp beta fexp x) *)
  rewrite ulp_neq_0;[idtac|now apply Rgt_not_eq].
(* Goal: Rle (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (Fcore_Raux.bpow beta (canonic_exp beta fexp1 (Rminus x y))) (Fcore_Raux.bpow beta (canonic_exp beta fexp2 (Rminus x y))))) *)
  unfold canonic_exp.
  destruct (ln_beta y) as (ey, Hey); simpl in *.
(* Goal: Rlt y (Fcore_Raux.bpow beta (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) *)
  apply Rlt_le_trans with (bpow ey).
  + now rewrite <- (Rabs_right y); [apply Hey|apply Rle_ge].
  + now apply bpow_le.
Qed.

Lemma ln_beta_minus_disj :
  forall x y,
  0 < x -> 0 < y ->
  (ln_beta y <= ln_beta x - 2)%Z ->
  ((ln_beta (x - y) = ln_beta x :> Z)
   \/ (ln_beta (x - y) = (ln_beta x - 1)%Z :> Z)).
Proof.
(* Goal: forall (x y : R) (_ : Rlt (IZR Z0) x) (_ : Rlt (IZR Z0) y) (_ : Z.le (ln_beta_val beta y (Fcore_Raux.ln_beta beta y)) (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos (xO xH)))), or (@eq Z (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (@eq Z (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))) (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH))) *)
intros x y Px Py Hln.
(* Goal: or (@eq Z (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (@eq Z (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))) (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH))) *)
assert (Hxy : y < x); [now apply (ln_beta_lt_pos beta); [ |omega]|].
(* Goal: or (@eq Z (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (@eq Z (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))) (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH))) *)
generalize (ln_beta_minus beta x y Py Hxy); intro Hln2.
(* Goal: or (@eq Z (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (@eq Z (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))) (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH))) *)
generalize (ln_beta_minus_lb beta x y Px Py Hln); intro Hln3.
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
omega.
Qed.

Lemma ln_beta_minus_separated :
  forall fexp : Z -> Z, Valid_exp fexp ->
  forall x y,
  0 < x -> 0 < y -> y < x ->
  bpow (ln_beta x - 1) < x ->
  generic_format beta fexp x -> (ln_beta y <= fexp (ln_beta x))%Z ->
  (ln_beta (x - y) = ln_beta x :> Z).
Proof.
(* Goal: forall (fexp : forall _ : Z, Z) (_ : Valid_exp fexp) (x y : R) (_ : Rlt (IZR Z0) x) (_ : Rlt (IZR Z0) y) (_ : Rlt y x) (_ : Rlt (Fcore_Raux.bpow beta (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH))) x) (_ : generic_format beta fexp x) (_ : Z.le (ln_beta_val beta y (Fcore_Raux.ln_beta beta y)) (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))), @eq Z (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) *)
intros fexp Vfexp x y Px Py Yltx Xgtpow Fx Ly.
(* Goal: @eq Z (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) *)
apply ln_beta_unique.
(* Goal: and (Rle (Fcore_Raux.bpow beta (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH))) x'') (Rlt x'' (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) *)
split.
- apply Rabs_ge; right.
  assert (Hy : y < ulp beta fexp (bpow (ln_beta x - 1))).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
  { rewrite ulp_bpow.
    replace (_ + _)%Z with (ln_beta x : Z) by ring.
    rewrite <- (Rabs_right y); [|now apply Rle_ge; apply Rlt_le].
(* Goal: Rlt y (Fcore_Raux.bpow beta (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) *)
    apply Rlt_le_trans with (bpow (ln_beta y)).
    - apply bpow_ln_beta_gt.
    - now apply bpow_le. }
(* Goal: Rle (Fcore_Raux.bpow beta (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH))) (Rminus x y) *)
  apply (Rplus_le_reg_r y); ring_simplify.
  apply Rle_trans with (bpow (ln_beta x - 1)
                        + ulp beta fexp (bpow (ln_beta x - 1))).
  + now apply Rplus_le_compat_l; apply Rlt_le.
  + rewrite <- succ_eq_pos;[idtac|apply bpow_ge_0].
(* Goal: Rle (succ beta fexp (Fcore_Raux.bpow beta (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH)))) x *)
    apply succ_le_lt; [apply Vfexp|idtac|exact Fx|assumption].
    apply (generic_format_bpow beta fexp (ln_beta x - 1)).
    replace (_ + _)%Z with (ln_beta x : Z) by ring.
(* Goal: Z.le (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH)) *)
    assert (fexp (ln_beta x) < ln_beta x)%Z; [|omega].
(* Goal: Z.lt (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) *)
    now apply ln_beta_generic_gt; [|now apply Rgt_not_eq|].
- rewrite Rabs_right.
  + apply Rlt_trans with x.
    * rewrite <- (Rplus_0_r x) at 2.
(* Goal: Rlt (Rplus a (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta a (Fcore_Raux.ln_beta beta a)))))) (Rplus a (ulp beta fexp1 a)) *)
      apply Rplus_lt_compat_l.
      rewrite <- Ropp_0.
(* Goal: Rlt (Ropp (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Ropp (IZR Z0)) *)
      now apply Ropp_lt_contravar.
    * apply Rabs_lt_inv.
(* Goal: Rlt (Rabs (sqrt x)) (Fcore_Raux.bpow beta (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) *)
      apply bpow_ln_beta_gt.
  + lra.
Qed.

Definition double_round_plus_hyp fexp1 fexp2 :=
  (forall ex ey, (fexp1 (ex + 1) - 1 <= ey)%Z -> (fexp2 ex <= fexp1 ey)%Z)
  /\ (forall ex ey, (fexp1 (ex - 1) + 1 <= ey)%Z -> (fexp2 ex <= fexp1 ey)%Z)
  /\ (forall ex ey, (fexp1 ex - 1 <= ey)%Z -> (fexp2 ex <= fexp1 ey)%Z)
  /\ (forall ex ey, (ex - 1 <= ey)%Z -> (fexp2 ex <= fexp1 ey)%Z).

Lemma double_round_plus_aux0_aux_aux :
  forall (fexp1 fexp2 : Z -> Z),
  forall x y,
  (fexp1 (ln_beta x) <= fexp1 (ln_beta y))%Z ->
  (fexp2 (ln_beta (x + y))%Z <= fexp1 (ln_beta x))%Z ->
  (fexp2 (ln_beta (x + y))%Z <= fexp1 (ln_beta y))%Z ->
  generic_format beta fexp1 x -> generic_format beta fexp1 y ->
  generic_format beta fexp2 (x + y).
Proof.
(* Goal: forall (fexp1 fexp2 : forall _ : Z, Z) (x y : R) (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp1 (ln_beta_val beta y (Fcore_Raux.ln_beta beta y)))) (_ : Z.le (fexp2 (ln_beta_val beta (Rplus x y) (Fcore_Raux.ln_beta beta (Rplus x y)))) (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) (_ : Z.le (fexp2 (ln_beta_val beta (Rplus x y) (Fcore_Raux.ln_beta beta (Rplus x y)))) (fexp1 (ln_beta_val beta y (Fcore_Raux.ln_beta beta y)))) (_ : generic_format beta fexp1 x) (_ : generic_format beta fexp1 y), generic_format beta fexp2 (Rplus x y) *)
intros fexp1 fexp2 x y Oxy Hlnx Hlny Fx Fy.
(* Goal: @eq R (sqrt x) (IZR Z0) *)
destruct (Req_dec x 0) as [Zx|Nzx].
- (* x = 0 *)
  rewrite Zx, Rplus_0_l in Hlny |- *.
(* Goal: generic_format beta fexp2 x *)
  now apply (generic_inclusion_ln_beta beta fexp1).
- (* x <> 0 *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rminus x y))) (round beta fexp1 (Znearest choice1) (Rminus x y)) *)
  destruct (Req_dec y 0) as [Zy|Nzy].
  + (* y = 0 *)
    rewrite Zy, Rplus_0_r in Hlnx |- *.
(* Goal: generic_format beta fexp2 x *)
    now apply (generic_inclusion_ln_beta beta fexp1).
  + (* y <> 0 *)
(* Goal: generic_format beta fexp2 (Rplus x y) *)
    revert Fx Fy.
    unfold generic_format at -3, canonic_exp, F2R; simpl.
(* Goal: forall (_ : @eq R x (Rmult (Z2R (Ztrunc (scaled_mantissa beta fexp1 x))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (_ : @eq R y (Rmult (Z2R (Ztrunc (scaled_mantissa beta fexp1 y))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta y (Fcore_Raux.ln_beta beta y)))))), generic_format beta fexp2 (Rplus x y) *)
    set (mx := Ztrunc (scaled_mantissa beta fexp1 x)).
(* Goal: forall (_ : @eq R x (Rmult (Z2R mx) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (_ : @eq R y (Rmult (Z2R (Ztrunc (scaled_mantissa beta fexp1 y))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta y (Fcore_Raux.ln_beta beta y)))))), generic_format beta fexp2 (Rplus x y) *)
    set (my := Ztrunc (scaled_mantissa beta fexp1 y)).
(* Goal: forall (_ : @eq R x (Rmult (Z2R mx) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (_ : @eq R y (Rmult (Z2R my) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta y (Fcore_Raux.ln_beta beta y)))))), generic_format beta fexp2 (Rplus x y) *)
    intros Fx Fy.
    set (fxy := Float beta (mx + my * (beta ^ (fexp1 (ln_beta y)
                                               - fexp1 (ln_beta x))))
                      (fexp1 (ln_beta x))).
    assert (Hxy : x + y = F2R fxy).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
    { unfold fxy, F2R; simpl.
(* Goal: Rlt (Z2R (Z.mul (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Z.pow (radix_val beta) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Z2R (Z.add (Z.mul (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Z.pow (radix_val beta) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Zpos xH))) *)
      rewrite Z2R_plus.
(* Goal: @eq R (Rmult (Rplus (Z2R (Zfloor (scaled_mantissa beta fexp2 rd))) (Z2R (Z.mul n (Z.pow (radix_val beta) (Z.sub (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Zpos xH)) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (canonic_exp beta fexp2 x))) x *)
      rewrite Rmult_plus_distr_r.
      rewrite <- Fx.
(* Goal: @eq R (Rmult (Z2R (Z.mul (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Z.pow (radix_val beta) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
      rewrite Z2R_mult.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Z2R (Z.pow (radix_val beta) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
      rewrite Z2R_Zpower; [|omega].
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
      bpow_simplify.
      now rewrite <- Fy. }
(* Goal: generic_format beta fexp2 (Rplus x y) *)
    apply generic_format_F2R' with (f := fxy); [now rewrite Hxy|].
(* Goal: forall _ : not (@eq R x (IZR Z0)), Z.le (canonic_exp beta fexp2 x) (@Fexp beta f) *)
    intros _.
(* Goal: Z.le (canonic_exp beta fexp2 (Rmult x y)) (@Fexp beta fxy) *)
    now unfold canonic_exp, fxy; simpl.
Qed.

Lemma double_round_plus_aux0_aux :
  forall (fexp1 fexp2 : Z -> Z),
  forall x y,
  (fexp2 (ln_beta (x + y))%Z <= fexp1 (ln_beta x))%Z ->
  (fexp2 (ln_beta (x + y))%Z <= fexp1 (ln_beta y))%Z ->
  generic_format beta fexp1 x -> generic_format beta fexp1 y ->
  generic_format beta fexp2 (x + y).
Proof.
(* Goal: forall (fexp1 fexp2 : forall _ : Z, Z) (x y : R) (_ : Z.le (fexp2 (ln_beta_val beta (Rplus x y) (Fcore_Raux.ln_beta beta (Rplus x y)))) (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) (_ : Z.le (fexp2 (ln_beta_val beta (Rplus x y) (Fcore_Raux.ln_beta beta (Rplus x y)))) (fexp1 (ln_beta_val beta y (Fcore_Raux.ln_beta beta y)))) (_ : generic_format beta fexp1 x) (_ : generic_format beta fexp1 y), generic_format beta fexp2 (Rplus x y) *)
intros fexp1 fexp2 x y Hlnx Hlny Fx Fy.
(* Goal: generic_format beta fexp2 (Rplus x y) *)
destruct (Z.le_gt_cases (fexp1 (ln_beta x)) (fexp1 (ln_beta y))) as [Hle|Hgt].
- now apply (double_round_plus_aux0_aux_aux fexp1).
- rewrite Rplus_comm in Hlnx, Hlny |- *.
(* Goal: generic_format beta fexp2 (Rplus y x) *)
  now apply (double_round_plus_aux0_aux_aux fexp1); [omega| | | |].
Qed.

(* fexp1 (ln_beta x) - 1 <= ln_beta y :
 * addition is exact in the largest precision (fexp2). *)
Lemma double_round_plus_aux0 :
  forall (fexp1 fexp2 : Z -> Z), Valid_exp fexp1 ->
  double_round_plus_hyp fexp1 fexp2 ->
  forall x y,
  (0 < x)%R -> (0 < y)%R -> (y <= x)%R ->
  (fexp1 (ln_beta x) - 1 <= ln_beta y)%Z ->
  generic_format beta fexp1 x -> generic_format beta fexp1 y ->
  generic_format beta fexp2 (x + y).
Proof.
(* Goal: forall (fexp1 fexp2 : forall _ : Z, Z) (_ : Valid_exp fexp1) (_ : double_round_plus_hyp fexp1 fexp2) (x y : R) (_ : Rlt (IZR Z0) x) (_ : Rlt (IZR Z0) y) (_ : Rle y x) (_ : Z.le (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Zpos xH)) (ln_beta_val beta y (Fcore_Raux.ln_beta beta y))) (_ : generic_format beta fexp1 x) (_ : generic_format beta fexp1 y), generic_format beta fexp2 (Rplus x y) *)
intros fexp1 fexp2 Vfexp1 Hexp x y Px Py Hyx Hln Fx Fy.
(* Goal: generic_format beta fexp2 (Rplus x y) *)
assert (Nny : (0 <= y)%R); [now apply Rlt_le|].
(* Goal: generic_format beta fexp2 (Rplus x y) *)
destruct Hexp as (_,(Hexp2,(Hexp3,Hexp4))).
(* Goal: generic_format beta fexp2 (Rplus x y) *)
destruct (Z.le_gt_cases (ln_beta y) (fexp1 (ln_beta x))) as [Hle|Hgt].
- (* ln_beta y <= fexp1 (ln_beta x) *)
  assert (Lxy : ln_beta (x + y) = ln_beta x :> Z);
  [now apply (ln_beta_plus_separated fexp1)|].
  apply (double_round_plus_aux0_aux fexp1);
(* Goal: Z.le (fexp1 (ln_beta_val beta (Rplus x y) (Fcore_Raux.ln_beta beta (Rplus x y)))) (ln_beta_val beta (Rplus x y) (Fcore_Raux.ln_beta beta (Rplus x y))) *)
    [| |assumption|assumption]; rewrite Lxy.
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  + now apply Hexp4; omega.
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  + now apply Hexp3; omega.
- (* fexp1 (ln_beta x) < ln_beta y *)
(* Goal: generic_format beta fexp2 (Rplus x y) *)
  apply (double_round_plus_aux0_aux fexp1); [| |assumption|assumption].
(* Goal: Z.le (fexp2 (ln_beta_val beta (Rplus x y) (Fcore_Raux.ln_beta beta (Rplus x y)))) (fexp1 (ln_beta_val beta y (Fcore_Raux.ln_beta beta y))) *)
  destruct (ln_beta_plus_disj x y Py Hyx) as [Lxy|Lxy]; rewrite Lxy.
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  + now apply Hexp4; omega.
  + apply Hexp2; apply (ln_beta_le beta y x Py) in Hyx.
    replace (_ - _)%Z with (ln_beta x : Z) by ring.
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
    omega.
  + destruct (ln_beta_plus_disj x y Py Hyx) as [Lxy|Lxy]; rewrite Lxy.
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
    * now apply Hexp3; omega.
    * apply Hexp2.
      replace (_ - _)%Z with (ln_beta x : Z) by ring.
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
      omega.
Qed.

Lemma double_round_plus_aux1_aux :
  forall k, (0 < k)%Z ->
  forall (fexp : Z -> Z),
  forall x y,
  0 < x -> 0 < y ->
  (ln_beta y <= fexp (ln_beta x) - k)%Z ->
  (ln_beta (x + y) = ln_beta x :> Z) ->
  generic_format beta fexp x ->
  0 < (x + y) - round beta fexp Zfloor (x + y) < bpow (fexp (ln_beta x) - k).
Proof.
(* Goal: Rlt (Rinv (Z2R (Z.mul (radix_val beta) (radix_val beta)))) (Rinv (IZR (Zpos (xO xH)))) *)
assert (Hbeta : (2 <= beta)%Z).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ destruct beta as (beta_val,beta_prop).
  now apply Zle_bool_imp_le. }
(* Goal: forall (k : Z) (_ : Z.lt Z0 k) (fexp : forall _ : Z, Z) (x y : R) (_ : Rlt (IZR Z0) x) (_ : Rlt (IZR Z0) y) (_ : Z.le (ln_beta_val beta y (Fcore_Raux.ln_beta beta y)) (Z.sub (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) k)) (_ : @eq Z (ln_beta_val beta (Rplus x y) (Fcore_Raux.ln_beta beta (Rplus x y))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : generic_format beta fexp x), and (Rlt (IZR Z0) (Rminus (Rplus x y) (round beta fexp Zfloor (Rplus x y)))) (Rlt (Rminus (Rplus x y) (round beta fexp Zfloor (Rplus x y))) (Fcore_Raux.bpow beta (Z.sub (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) k))) *)
intros k Hk fexp x y Px Py Hln Hlxy Fx.
(* Goal: Rle (Rminus (round beta fexp Zceil (Rminus x y)) (Rminus x y)) y *)
revert Fx.
(* Goal: forall _ : generic_format beta fexp x, and (Rlt (IZR Z0) (Rminus (Rplus x y) (round beta fexp Zfloor (Rplus x y)))) (Rlt (Rminus (Rplus x y) (round beta fexp Zfloor (Rplus x y))) (Fcore_Raux.bpow beta (Z.sub (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) k))) *)
unfold round, generic_format, F2R, scaled_mantissa, canonic_exp; simpl.
(* Goal: forall _ : @eq R x (Rmult (Z2R (Ztrunc (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))), and (Rlt (IZR Z0) (Rminus (Rplus x y) (Rmult (Z2R (Zfloor (Rmult (Rplus x y) (Fcore_Raux.bpow beta (Z.opp (fexp (ln_beta_val beta (Rplus x y) (Fcore_Raux.ln_beta beta (Rplus x y))))))))) (Fcore_Raux.bpow beta (fexp (ln_beta_val beta (Rplus x y) (Fcore_Raux.ln_beta beta (Rplus x y)))))))) (Rlt (Rminus (Rplus x y) (Rmult (Z2R (Zfloor (Rmult (Rplus x y) (Fcore_Raux.bpow beta (Z.opp (fexp (ln_beta_val beta (Rplus x y) (Fcore_Raux.ln_beta beta (Rplus x y))))))))) (Fcore_Raux.bpow beta (fexp (ln_beta_val beta (Rplus x y) (Fcore_Raux.ln_beta beta (Rplus x y))))))) (Fcore_Raux.bpow beta (Z.sub (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) k))) *)
rewrite Hlxy.
set (mx := Ztrunc (x * bpow (- fexp (ln_beta x)))).
(* Goal: forall _ : @eq R x (Rmult (Z2R mx) (Fcore_Raux.bpow beta (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))), and (Rlt (IZR Z0) (Rminus (Rplus x y) (Rmult (Z2R (Zfloor (Rmult (Rplus x y) (Fcore_Raux.bpow beta (Z.opp (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Rlt (Rminus (Rplus x y) (Rmult (Z2R (Zfloor (Rmult (Rplus x y) (Fcore_Raux.bpow beta (Z.opp (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (Z.sub (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) k))) *)
intros Fx.
assert (R : (x + y) * bpow (- fexp (ln_beta x))
            = Z2R mx + y * bpow (- fexp (ln_beta x))).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ rewrite Fx at 1.
(* Goal: @eq R (Rmult (Rplus (Z2R (Zfloor (scaled_mantissa beta fexp2 rd))) (Z2R (Z.mul n (Z.pow (radix_val beta) (Z.sub (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Zpos xH)) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (canonic_exp beta fexp2 x))) x *)
  rewrite Rmult_plus_distr_r.
  now bpow_simplify. }
(* Goal: and (Rlt (IZR Z0) (Rminus (Rplus x y) (Rmult (Z2R (Zfloor (Rmult (Rplus x y) (Fcore_Raux.bpow beta (Z.opp (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Rlt (Rminus (Rplus x y) (Rmult (Z2R (Zfloor (Rmult (Rplus x y) (Fcore_Raux.bpow beta (Z.opp (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (Z.sub (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) k))) *)
rewrite R.
assert (LB : 0 < y * bpow (- fexp (ln_beta x))).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ rewrite <- (Rmult_0_r y).
  now apply Rmult_lt_compat_l; [|apply bpow_gt_0]. }
assert (UB : y * bpow (- fexp (ln_beta x)) < / Z2R (beta ^ k)).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ apply Rlt_le_trans with (bpow (ln_beta y) * bpow (- fexp (ln_beta x))).
  - apply Rmult_lt_compat_r; [now apply bpow_gt_0|].
    rewrite <- (Rabs_right y) at 1; [|now apply Rle_ge; apply Rlt_le].
(* Goal: Rlt (Rabs (sqrt x)) (Fcore_Raux.bpow beta (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) *)
    apply bpow_ln_beta_gt.
  - apply Rle_trans with (bpow (fexp (ln_beta x) - k)
                          * bpow (- fexp (ln_beta x)))%R.
    + apply Rmult_le_compat_r; [now apply bpow_ge_0|].
(* Goal: Rle (Fcore_Raux.bpow beta (ln_beta_val beta y (Fcore_Raux.ln_beta beta y))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) *)
      now apply bpow_le.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    + bpow_simplify.
(* Goal: Rle (Rinv (Z2R (Z.pow (radix_val beta) k))) (Fcore_Raux.bpow beta (Z.opp k)) *)
      rewrite bpow_opp.
(* Goal: Rle (Rinv (Fcore_Raux.bpow beta k)) (Rinv (Z2R (Z.pow (radix_val beta) k))) *)
      destruct k.
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
      * omega.
      * simpl; unfold Fcore_Raux.bpow, Z.pow_pos.
(* Goal: Rle (Rinv (Z2R (Pos.iter Z (Z.mul (radix_val beta)) (Zpos xH) p))) (Rinv (Z2R (Pos.iter Z (Z.mul (radix_val beta)) (Zpos xH) p))) *)
        now apply Rle_refl.
      * casetype False; apply (Zlt_irrefl 0).
(* Goal: Z.lt Z0 Z0 *)
        apply (Zlt_trans _ _ _ Hk).
        apply Zlt_neg_0. }
(* Goal: and (Rlt (IZR Z0) (Rminus (Rplus x y) (Rmult (Z2R (Zfloor (Rplus (Z2R mx) (Rmult y (Fcore_Raux.bpow beta (Z.opp (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))))) (Fcore_Raux.bpow beta (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Rlt (Rminus (Rplus x y) (Rmult (Z2R (Zfloor (Rplus (Z2R mx) (Rmult y (Fcore_Raux.bpow beta (Z.opp (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))))) (Fcore_Raux.bpow beta (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (Z.sub (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) k))) *)
rewrite (Zfloor_imp mx).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ split; ring_simplify.
  - apply (Rmult_lt_reg_r (bpow (- fexp (ln_beta x)))); [now apply bpow_gt_0|].
(* Goal: Rlt (Rmult (IZR Z0) (Fcore_Raux.bpow beta (Z.opp (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Rmult (Rminus (Rplus x y) (Rmult (Z2R mx) (Fcore_Raux.bpow beta (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (Z.opp (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) *)
    rewrite Rmult_minus_distr_r, Rmult_0_l.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    bpow_simplify.
(* Goal: Rlt (Rminus (Rmult (Rplus x y) (Fcore_Raux.bpow beta (Z.opp (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Z2R mx)) (Fcore_Raux.bpow beta (Z.opp k)) *)
    rewrite R; ring_simplify.
(* Goal: Rlt (IZR Z0) (Rmult y (Fcore_Raux.bpow beta (Z.opp (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) *)
    now apply Rmult_lt_0_compat; [|apply bpow_gt_0].
  - apply (Rmult_lt_reg_r (bpow (- fexp (ln_beta x)))); [now apply bpow_gt_0|].
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rmult (Rminus (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))))) *)
    rewrite Rmult_minus_distr_r.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    bpow_simplify.
(* Goal: Rlt (Rminus (Rmult (Rplus x y) (Fcore_Raux.bpow beta (Z.opp (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Z2R mx)) (Fcore_Raux.bpow beta (Z.opp k)) *)
    rewrite R; ring_simplify.
(* Goal: Rlt (Rmult y (Fcore_Raux.bpow beta (Z.opp (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (Z.opp k)) *)
    apply (Rlt_le_trans _ _ _ UB).
(* Goal: Rle (Rinv (Z2R (Z.pow (radix_val beta) k))) (Fcore_Raux.bpow beta (Z.opp k)) *)
    rewrite bpow_opp.
(* Goal: Rle (Rinv (Z2R (Z.pow (radix_val beta) k))) (Rinv (Fcore_Raux.bpow beta k)) *)
    apply Rinv_le; [now apply bpow_gt_0|].
    now rewrite Z2R_Zpower; [right|omega]. }
(* Goal: and (Rle (Fcore_Raux.bpow beta (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH))) x'') (Rlt x'' (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) *)
split.
- rewrite <- Rplus_0_r at 1; apply Rplus_le_compat_l.
(* Goal: Rle (IZR Z0) x *)
  now apply Rlt_le.
- rewrite Z2R_plus; apply Rplus_lt_compat_l.
(* Goal: Rlt (Rmult y (Fcore_Raux.bpow beta (Z.opp (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (IZR (Zpos xH)) *)
  apply (Rmult_lt_reg_r (bpow (fexp (ln_beta x)))); [now apply bpow_gt_0|].
(* Goal: Rlt (Rmult (Rmult y (Fcore_Raux.bpow beta (Z.opp (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) (Rmult (Z2R (Zpos xH)) (Fcore_Raux.bpow beta (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
  rewrite Rmult_1_l.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
  bpow_simplify.
(* Goal: Rlt y (Fcore_Raux.bpow beta (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) *)
  apply Rlt_trans with (bpow (ln_beta y)).
  + rewrite <- Rabs_right at 1; [|now apply Rle_ge; apply Rlt_le].
(* Goal: Rlt (Rabs (sqrt x)) (Fcore_Raux.bpow beta (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) *)
    apply bpow_ln_beta_gt.
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  + apply bpow_lt; omega.
Qed.

(* ln_beta y <= fexp1 (ln_beta x) - 2 : double_round_lt_mid applies. *)
Lemma double_round_plus_aux1 :
  forall (fexp1 fexp2 : Z -> Z),
  Valid_exp fexp1 -> Valid_exp fexp2 ->
  forall (choice1 choice2 : Z -> bool),
  double_round_plus_hyp fexp1 fexp2 ->
  forall x y,
  0 < x -> 0 < y ->
  (ln_beta y <= fexp1 (ln_beta x) - 2)%Z ->
  generic_format beta fexp1 x ->
  double_round_eq fexp1 fexp2 choice1 choice2 (x + y).
Proof.
(* Goal: Rlt (Rinv (Z2R (Z.mul (radix_val beta) (radix_val beta)))) (Rinv (IZR (Zpos (xO xH)))) *)
assert (Hbeta : (2 <= beta)%Z).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ destruct beta as (beta_val,beta_prop).
  now apply Zle_bool_imp_le. }
(* Goal: forall (fexp1 fexp2 : forall _ : Z, Z) (_ : Valid_exp fexp1) (_ : Valid_exp fexp2) (choice1 choice2 : forall _ : Z, bool) (_ : double_round_plus_hyp fexp1 fexp2) (x y : R) (_ : Rlt (IZR Z0) x) (_ : Rlt (IZR Z0) y) (_ : Z.le (ln_beta_val beta y (Fcore_Raux.ln_beta beta y)) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Zpos (xO xH)))) (_ : generic_format beta fexp1 x), double_round_eq fexp1 fexp2 choice1 choice2 (Rplus x y) *)
intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x y Px Py Hly Fx.
assert (Lxy : ln_beta (x + y) = ln_beta x :> Z);
  [now apply (ln_beta_plus_separated fexp1); [|apply Rlt_le| |omega]|].
(* Goal: forall _ : not (@eq R x R0), Z.le (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) *)
(* Goal: generic_format beta fexp1 x *)
destruct Hexp as (_,(_,(_,Hexp4))).
assert (Hf2 : (fexp2 (ln_beta x) <= fexp1 (ln_beta x))%Z);
  [now apply Hexp4; omega|].
assert (Bpow2 : bpow (- 2) <= / 2 * / 2).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ replace (/2 * /2) with (/4) by field.
(* Goal: Rle (Fcore_Raux.bpow beta (Zneg (xO xH))) (Rinv (IZR (Zpos (xO (xO xH))))) *)
  rewrite (bpow_opp _ 2).
(* Goal: Rle (Rinv (Z2R (radix_val beta))) (Rinv (IZR (Zpos (xO xH)))) *)
  apply Rinv_le; [lra|].
  apply (Z2R_le (2 * 2) (beta * (beta * 1))).
(* Goal: @eq R (Rplus (Rmult (Z2R (Zfloor (scaled_mantissa beta fexp2 rd))) (Fcore_Raux.bpow beta (canonic_exp beta fexp2 x))) (Rmult (Rmult (Z2R n) (Rinv (Z2R (Z.mul (radix_val beta) (Zpos xH))))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) x *)
  rewrite Zmult_1_r.
  now apply Zmult_le_compat; omega. }
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
assert (P2 : (0 < 2)%Z) by omega.
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
unfold double_round_eq.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rplus x y))) (round beta fexp1 (Znearest choice1) (Rplus x y)) *)
apply double_round_lt_mid.
(* Goal: Valid_exp fexp1 *)
- exact Vfexp1.
- exact Vfexp2.
- lra.
- now rewrite Lxy.
- rewrite Lxy.
(* Goal: Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) *)
  assert (fexp1 (ln_beta x) < ln_beta x)%Z; [|omega].
(* Goal: Z.lt (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) *)
  now apply ln_beta_generic_gt; [|apply Rgt_not_eq|].
- unfold midp.
  apply (Rplus_lt_reg_r (- round beta fexp1 Zfloor (x + y))).
  apply (Rlt_le_trans _ _ _ (proj2 (double_round_plus_aux1_aux 2 P2 fexp1 x y Px
                                                               Py Hly Lxy Fx))).
(* Goal: Rlt (Rplus (Rminus (round beta fexp1 Zceil (Rminus x y)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y)))) (Rminus (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y))) (Rminus x y))) (Rplus (Rminus x y) (Rminus (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y))) (Rminus x y))) *)
  ring_simplify.
(* Goal: Rle (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Zpos xH))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (ulp beta fexp1 (Rplus x y)) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) *)
  rewrite ulp_neq_0;[idtac|now apply Rgt_not_eq, Rplus_lt_0_compat].
(* Goal: Z.le (fexp1 (ln_beta_val beta (Rplus x y) (Fcore_Raux.ln_beta beta (Rplus x y)))) (ln_beta_val beta (Rplus x y) (Fcore_Raux.ln_beta beta (Rplus x y))) *)
  unfold canonic_exp; rewrite Lxy.
  apply (Rmult_le_reg_r (bpow (- fexp1 (ln_beta x)))); [now apply bpow_gt_0|].
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
  bpow_simplify.
(* Goal: Rle (Fcore_Raux.bpow beta (Zneg (xO xH))) (Rminus (Rinv (IZR (Zpos (xO xH)))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (Z.sub (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) *)
  apply (Rle_trans _ _ _ Bpow2).
  rewrite <- (Rmult_1_r (/ 2)) at 3.
(* Goal: forall _ : Rlt (Rplus (Rplus x' (Rmult (Rinv (IZR (Zpos (xO xH)))) u1)) (Rmult (Rinv (IZR (Zpos (xO xH)))) u2)) x, Rlt (Rplus (Rminus (Rplus x' u1) (Rmult (Rinv (IZR (Zpos (xO xH)))) u1)) (Rmult (Rinv (IZR (Zpos (xO xH)))) u2)) x *)
  apply Rmult_le_compat_l; lra.
- rewrite ulp_neq_0;[idtac|now apply Rgt_not_eq, Rplus_lt_0_compat].
(* Goal: Z.le (fexp1 (ln_beta_val beta (Rplus x y) (Fcore_Raux.ln_beta beta (Rplus x y)))) (ln_beta_val beta (Rplus x y) (Fcore_Raux.ln_beta beta (Rplus x y))) *)
  unfold round, F2R, scaled_mantissa, canonic_exp; simpl; rewrite Lxy.
(* Goal: forall _ : Z.le (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH)), Rlt (Rplus (midp' fexp1 (Rminus x y)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 (Rminus x y)))) (Rminus x y) *)
  intro Hf2'.
  apply (Rmult_lt_reg_r (bpow (- fexp1 (ln_beta x))));
    [now apply bpow_gt_0|].
(* Goal: Rlt (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (IZR (Zpos xH)) *)
  apply (Rmult_lt_reg_r (bpow (fexp1 (ln_beta x)))); [now apply bpow_gt_0|].
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
  bpow_simplify.
  apply (Rplus_lt_reg_r (- round beta fexp1 Zfloor (x + y))).
(* Goal: Rlt (Rplus (Rminus (round beta fexp1 Zceil (Rminus x y)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y)))) (Rminus (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y))) (Rminus x y))) (Rplus (Rminus x y) (Rminus (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y))) (Rminus x y))) *)
  unfold midp; ring_simplify.
  apply (Rlt_le_trans _ _ _ (proj2 (double_round_plus_aux1_aux 2 P2 fexp1 x y Px
                                                               Py Hly Lxy Fx))).
  apply (Rmult_le_reg_r (bpow (- fexp1 (ln_beta x)))); [now apply bpow_gt_0|].
(* Goal: Rle (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Zpos xH))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (ulp beta fexp1 (Rplus x y)) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) *)
  rewrite ulp_neq_0;[idtac|now apply Rgt_not_eq, Rplus_lt_0_compat].
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
  unfold canonic_exp; rewrite Lxy, Rmult_minus_distr_r; bpow_simplify.
(* Goal: Rle (Fcore_Raux.bpow beta (Zneg (xO xH))) (Rminus (Rinv (IZR (Zpos (xO xH)))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (Z.sub (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) *)
  apply (Rle_trans _ _ _ Bpow2).
  rewrite <- (Rmult_1_r (/ 2)) at 3; rewrite <- Rmult_minus_distr_l.
(* Goal: Rle (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rdiv (IZR (Zpos (xO xH))) (IZR (Zpos (xI xH))))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (IZR (Zpos xH)) (Fcore_Raux.bpow beta (Z.sub (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))))) *)
  apply Rmult_le_compat_l; [lra|].
  apply (Rplus_le_reg_r (- 1)); ring_simplify.
  replace (_ - _) with (- (/ 2)) by lra.
(* Goal: Rle (Ropp (Rinv (IZR (Zpos (xI xH))))) (Ropp (Fcore_Raux.bpow beta (Z.sub (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) *)
  apply Ropp_le_contravar.
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
  { apply Rle_trans with (bpow (- 1)).
    - apply bpow_le; omega.
    - unfold Fcore_Raux.bpow, Z.pow_pos; simpl.
(* Goal: Rle (Rinv (Z2R (radix_val beta))) (Rinv (IZR (Zpos (xO xH)))) *)
      apply Rinv_le; [lra|].
      change 2 with (Z2R 2); apply Z2R_le; omega. }
Qed.

(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
(* double_round_plus_aux{0,1} together *)
Lemma double_round_plus_aux2 :
  forall (fexp1 fexp2 : Z -> Z),
  Valid_exp fexp1 -> Valid_exp fexp2 ->
  forall (choice1 choice2 : Z -> bool),
  double_round_plus_hyp fexp1 fexp2 ->
  forall x y,
  0 < x -> 0 < y -> y <= x ->
  generic_format beta fexp1 x ->
  generic_format beta fexp1 y ->
  double_round_eq fexp1 fexp2 choice1 choice2 (x + y).
Proof.
(* Goal: forall (fexp1 fexp2 : forall _ : Z, Z) (_ : Valid_exp fexp1) (_ : Valid_exp fexp2) (choice1 choice2 : forall _ : Z, bool) (_ : double_round_plus_hyp fexp1 fexp2) (x y : R) (_ : Rlt (IZR Z0) x) (_ : Rlt (IZR Z0) y) (_ : Rle y x) (_ : generic_format beta fexp1 x) (_ : generic_format beta fexp1 y), double_round_eq fexp1 fexp2 choice1 choice2 (Rplus x y) *)
intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x y Px Py Hyx Fx Fy.
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
unfold double_round_eq.
destruct (Zle_or_lt (ln_beta y) (fexp1 (ln_beta x) - 2)) as [Hly|Hly].
- (* ln_beta y <= fexp1 (ln_beta x) - 2 *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rplus x y))) (round beta fexp1 (Znearest choice1) (Rplus x y)) *)
  now apply double_round_plus_aux1.
- (* fexp1 (ln_beta x) - 2 < ln_beta y *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)) (round beta fexp1 (Znearest choice1) x) *)
  rewrite (round_generic beta fexp2).
  + reflexivity.
  + now apply valid_rnd_N.
  + assert (Hf1 : (fexp1 (ln_beta x) - 1 <= ln_beta y)%Z); [omega|].
(* Goal: generic_format beta fexp2 (Rplus x y) *)
    now apply (double_round_plus_aux0 fexp1).
Qed.

Lemma double_round_plus_aux :
  forall (fexp1 fexp2 : Z -> Z),
  Valid_exp fexp1 -> Valid_exp fexp2 ->
  forall (choice1 choice2 : Z -> bool),
  double_round_plus_hyp fexp1 fexp2 ->
  forall x y,
  0 <= x -> 0 <= y ->
  generic_format beta fexp1 x ->
  generic_format beta fexp1 y ->
  double_round_eq fexp1 fexp2 choice1 choice2 (x + y).
Proof.
(* Goal: forall (fexp1 fexp2 : forall _ : Z, Z) (_ : Valid_exp fexp1) (_ : Valid_exp fexp2) (choice1 choice2 : forall _ : Z, bool) (_ : double_round_plus_hyp fexp1 fexp2) (x y : R) (_ : Rle (IZR Z0) x) (_ : Rle (IZR Z0) y) (_ : generic_format beta fexp1 x) (_ : generic_format beta fexp1 y), double_round_eq fexp1 fexp2 choice1 choice2 (Rminus x y) *)
intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x y Nnx Nny Fx Fy.
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
unfold double_round_eq.
(* Goal: @eq R (sqrt x) (IZR Z0) *)
destruct (Req_dec x 0) as [Zx|Nzx].
- (* x = 0 *)
(* Goal: forall _ : not (@eq R x R0), Z.le (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) *)
(* Goal: generic_format beta fexp1 x *)
  destruct Hexp as (_,(_,(_,Hexp4))).
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rplus x y))) (round beta fexp1 (Znearest choice1) (Rplus x y)) *)
  rewrite Zx; rewrite Rplus_0_l.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)) (round beta fexp1 (Znearest choice1) x) *)
  rewrite (round_generic beta fexp2).
  + reflexivity.
  + now apply valid_rnd_N.
  + apply (generic_inclusion_ln_beta beta fexp1).
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
    now intros _; apply Hexp4; omega.
(* Goal: generic_format beta fexp1 y *)
    exact Fy.
- (* x <> 0 *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rminus x y))) (round beta fexp1 (Znearest choice1) (Rminus x y)) *)
  destruct (Req_dec y 0) as [Zy|Nzy].
  + (* y = 0 *)
(* Goal: forall _ : not (@eq R x R0), Z.le (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) *)
(* Goal: generic_format beta fexp1 x *)
    destruct Hexp as (_,(_,(_,Hexp4))).
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rplus x y))) (round beta fexp1 (Znearest choice1) (Rplus x y)) *)
    rewrite Zy; rewrite Rplus_0_r.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)) (round beta fexp1 (Znearest choice1) x) *)
    rewrite (round_generic beta fexp2).
    * reflexivity.
    * now apply valid_rnd_N.
    * apply (generic_inclusion_ln_beta beta fexp1).
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
      now intros _; apply Hexp4; omega.
(* Goal: generic_format beta fexp1 x *)
      exact Fx.
  + (* y <> 0 *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rminus x y))) (round beta fexp1 (Znearest choice1) (Rminus x y)) *)
    assert (Px : 0 < x); [lra|].
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rminus x y))) (round beta fexp1 (Znearest choice1) (Rminus x y)) *)
    assert (Py : 0 < y); [lra|].
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rminus x y))) (round beta fexp1 (Znearest choice1) (Rminus x y)) *)
    destruct (Rlt_or_le x y) as [H|H].
    * (* x < y *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rminus x y))) (round beta fexp1 (Znearest choice1) (Rminus x y)) *)
      apply Rlt_le in H.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rplus x y))) (round beta fexp1 (Znearest choice1) (Rplus x y)) *)
      rewrite Rplus_comm.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rplus x y))) (round beta fexp1 (Znearest choice1) (Rplus x y)) *)
      now apply double_round_plus_aux2.
    * now apply double_round_plus_aux2.
Qed.

Lemma double_round_minus_aux0_aux :
  forall (fexp1 fexp2 : Z -> Z),
  forall x y,
  (fexp2 (ln_beta (x - y))%Z <= fexp1 (ln_beta x))%Z ->
  (fexp2 (ln_beta (x - y))%Z <= fexp1 (ln_beta y))%Z ->
  generic_format beta fexp1 x -> generic_format beta fexp1 y ->
  generic_format beta fexp2 (x - y).
Proof.
(* Goal: forall (fexp1 fexp2 : forall _ : Z, Z) (x y : R) (_ : Z.le (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) (_ : Z.le (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (fexp1 (ln_beta_val beta y (Fcore_Raux.ln_beta beta y)))) (_ : generic_format beta fexp1 x) (_ : generic_format beta fexp1 y), generic_format beta fexp2 (Rminus x y) *)
intros fexp1 fexp2 x y.
replace (x - y)%R with (x + (- y))%R; [|ring].
(* Goal: forall (_ : Z.le (fexp2 (ln_beta_val beta (Rplus x (Ropp y)) (Fcore_Raux.ln_beta beta (Rplus x (Ropp y))))) (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) (_ : Z.le (fexp2 (ln_beta_val beta (Rplus x (Ropp y)) (Fcore_Raux.ln_beta beta (Rplus x (Ropp y))))) (fexp1 (ln_beta_val beta y (Fcore_Raux.ln_beta beta y)))) (_ : generic_format beta fexp1 x) (_ : generic_format beta fexp1 y), generic_format beta fexp2 (Rplus x (Ropp y)) *)
intros Hlnx Hlny Fx Fy.
rewrite <- (ln_beta_opp beta y) in Hlny.
(* Goal: @eq R (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (round beta fexp2 (Znearest (fun t : Z => negb (choice2 (Z.opp (Z.add t (Zpos xH)))))) (Rmult x (Rinv (Ropp y))))) (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (Rmult x (Rinv (Ropp y)))) *)
apply generic_format_opp in Fy.
(* Goal: generic_format beta fexp2 (Rplus x (Ropp y)) *)
now apply (double_round_plus_aux0_aux fexp1).
Qed.

(* fexp1 (ln_beta x) - 1 <= ln_beta y :
 * substraction is exact in the largest precision (fexp2). *)
Lemma double_round_minus_aux0 :
  forall (fexp1 fexp2 : Z -> Z),
  double_round_plus_hyp fexp1 fexp2 ->
  forall x y,
  0 < y -> y < x ->
  (fexp1 (ln_beta x) - 1 <= ln_beta y)%Z ->
  generic_format beta fexp1 x -> generic_format beta fexp1 y ->
  generic_format beta fexp2 (x - y).
Proof.
(* Goal: forall (fexp1 fexp2 : forall _ : Z, Z) (_ : double_round_plus_beta_ge_3_hyp fexp1 fexp2) (x y : R) (_ : Rlt (IZR Z0) y) (_ : Rlt y x) (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta y (Fcore_Raux.ln_beta beta y))) (_ : generic_format beta fexp1 x) (_ : generic_format beta fexp1 y), generic_format beta fexp2 (Rminus x y) *)
intros fexp1 fexp2 Hexp x y Py Hyx Hln Fx Fy.
(* Goal: generic_format beta fexp2 (Rminus x y) *)
assert (Px := Rlt_trans 0 y x Py Hyx).
(* Goal: generic_format beta fexp2 (Rminus x y) *)
destruct Hexp as (Hexp1,(_,(Hexp3,Hexp4))).
assert (Lyx : (ln_beta y <= ln_beta x)%Z);
  [now apply ln_beta_le; [|apply Rlt_le]|].
destruct (Z.lt_ge_cases (ln_beta x - 2) (ln_beta y)) as [Hlt|Hge].
- (* ln_beta x - 2 < ln_beta y *)
  assert (Hor : (ln_beta y = ln_beta x :> Z)
                \/ (ln_beta y = ln_beta x - 1 :> Z)%Z); [omega|].
(* Goal: generic_format beta fexp2 (Rminus x y) *)
  destruct Hor as [Heq|Heqm1].
  + (* ln_beta y = ln_beta x *)
(* Goal: generic_format beta fexp2 (Rminus x y) *)
    apply (double_round_minus_aux0_aux fexp1); [| |exact Fx|exact Fy].
    * apply Hexp4.
      apply Zle_trans with (ln_beta (x - y)); [omega|].
(* Goal: Z.le (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) *)
      now apply ln_beta_minus.
    * rewrite Heq.
(* Goal: Z.le (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) *)
      apply Hexp4.
      apply Zle_trans with (ln_beta (x - y)); [omega|].
(* Goal: Z.le (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) *)
      now apply ln_beta_minus.
  + (* ln_beta y = ln_beta x - 1 *)
(* Goal: generic_format beta fexp2 (Rminus x y) *)
    apply (double_round_minus_aux0_aux fexp1); [| |exact Fx|exact Fy].
    * apply Hexp4.
      apply Zle_trans with (ln_beta (x - y)); [omega|].
(* Goal: Z.le (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) *)
      now apply ln_beta_minus.
    * rewrite Heqm1.
(* Goal: Z.le (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) *)
      apply Hexp4.
(* Goal: Z.le (Z.sub (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))) (Zpos xH)) (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH)) *)
      apply Zplus_le_compat_r.
(* Goal: Z.le (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) *)
      now apply ln_beta_minus.
- (* ln_beta y <= ln_beta x - 2 *)
(* Goal: generic_format beta fexp2 (Rminus x y) *)
  destruct (ln_beta_minus_disj x y Px Py Hge) as [Lxmy|Lxmy].
  + (* ln_beta (x - y) = ln_beta x *)
(* Goal: generic_format beta fexp2 (Rminus x y) *)
    apply (double_round_minus_aux0_aux fexp1); [| |exact Fx|exact Fy].
    * apply Hexp4.
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
      omega.
    * now rewrite Lxmy; apply Hexp3.
  + (* ln_beta (x - y) = ln_beta x - 1 *)
    apply (double_round_minus_aux0_aux fexp1); [| |exact Fx|exact Fy];
    rewrite Lxmy.
    * apply Hexp1.
      replace (_ + _)%Z with (ln_beta x : Z); [|ring].
(* Goal: Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) *)
      now apply Zle_trans with (ln_beta y).
    * apply Hexp1.
      now replace (_ + _)%Z with (ln_beta x : Z); [|ring].
Qed.

(* ln_beta y <= fexp1 (ln_beta x) - 2,
 * fexp1 (ln_beta (x - y)) - 1 <= ln_beta y :
 * substraction is exact in the largest precision (fexp2). *)
Lemma double_round_minus_aux1 :
  forall (fexp1 fexp2 : Z -> Z),
  Valid_exp fexp1 -> Valid_exp fexp2 ->
  double_round_plus_hyp fexp1 fexp2 ->
  forall x y,
  0 < y -> y < x ->
  (ln_beta y <= fexp1 (ln_beta x) - 2)%Z ->
  (fexp1 (ln_beta (x - y)) - 1 <= ln_beta y)%Z ->
  generic_format beta fexp1 x -> generic_format beta fexp1 y ->
  generic_format beta fexp2 (x - y).
Proof.
intros fexp1 fexp2 Vfexp1 Vfexp2  Hexp x y Py Hyx Hln Hln' Fx Fy.
(* Goal: generic_format beta fexp2 (Rminus x y) *)
assert (Px := Rlt_trans 0 y x Py Hyx).
(* Goal: generic_format beta fexp2 (Rminus x y) *)
destruct Hexp as (Hexp1,(Hexp2,(Hexp3,Hexp4))).
assert (Lyx : (ln_beta y <= ln_beta x)%Z);
  [now apply ln_beta_le; [|apply Rlt_le]|].
assert (Hfx : (fexp1 (ln_beta x) < ln_beta x)%Z);
  [now apply ln_beta_generic_gt; [|apply Rgt_not_eq|]|].
assert (Hfy : (fexp1 (ln_beta y) < ln_beta y)%Z);
  [now apply ln_beta_generic_gt; [|apply Rgt_not_eq|]|].
(* Goal: generic_format beta fexp2 (Rminus x y) *)
apply (double_round_minus_aux0_aux fexp1); [| |exact Fx|exact Fy].
- apply Zle_trans with (fexp1 (ln_beta (x - y))).
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  + apply Hexp4; omega.
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  + omega.
- now apply Hexp3.
Qed.

Lemma double_round_minus_aux2_aux :
  forall (fexp : Z -> Z),
  Valid_exp fexp ->
  forall x y,
  0 < y -> y < x ->
  (ln_beta y <= fexp (ln_beta x) - 1)%Z ->
  generic_format beta fexp x ->
  generic_format beta fexp y ->
  round beta fexp Zceil (x - y) - (x - y) <= y.
Proof.
(* Goal: forall (fexp : forall _ : Z, Z) (_ : Valid_exp fexp) (x y : R) (_ : Rlt (IZR Z0) y) (_ : Rlt y x) (_ : Z.le (ln_beta_val beta y (Fcore_Raux.ln_beta beta y)) (Z.sub (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Zpos xH))) (_ : generic_format beta fexp x) (_ : generic_format beta fexp y), Rle (Rminus (round beta fexp Zceil (Rminus x y)) (Rminus x y)) y *)
intros fexp Vfexp x y Py Hxy Hly Fx Fy.
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rminus x y) *)
assert (Px := Rlt_trans 0 y x Py Hxy).
(* Goal: Rle (Rminus (round beta fexp Zceil (Rminus x y)) (Rminus x y)) y *)
revert Fx.
(* Goal: forall (_ : generic_format beta fexp1 x) (_ : generic_format beta fexp1 a), False *)
unfold generic_format, F2R, scaled_mantissa, canonic_exp; simpl.
set (mx := Ztrunc (x * bpow (- fexp (ln_beta x)))).
(* Goal: forall _ : @eq R x (Rmult (Z2R mx) (Fcore_Raux.bpow beta (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))), Rle (Rminus (round beta fexp Zceil (Rminus x y)) (Rminus x y)) y *)
intro Fx.
assert (Hfx : (fexp (ln_beta x) < ln_beta x)%Z);
  [now apply ln_beta_generic_gt; [|apply Rgt_not_eq|]|].
assert (Hfy : (fexp (ln_beta y) < ln_beta y)%Z);
  [now apply ln_beta_generic_gt; [|apply Rgt_not_eq|]|].
destruct (Rlt_or_le (bpow (ln_beta x - 1)) x) as [Hx|Hx].
- (* bpow (ln_beta x - 1) < x *)
  assert (Lxy : ln_beta (x - y) = ln_beta x :> Z);
    [now apply (ln_beta_minus_separated fexp); [| | | | | |omega]|].
  assert (Rxy : round beta fexp Zceil (x - y) = x).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
  { unfold round, F2R, scaled_mantissa, canonic_exp; simpl.
(* Goal: Z.le (fexp1 (ln_beta_val beta (Rplus x y) (Fcore_Raux.ln_beta beta (Rplus x y)))) (ln_beta_val beta (Rplus x y) (Fcore_Raux.ln_beta beta (Rplus x y))) *)
    rewrite Lxy.
(* Goal: @eq R (Rmult (Z2R (Zceil (Rmult (Rminus x y) (Fcore_Raux.bpow beta (Z.opp (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) x *)
    apply eq_sym; rewrite Fx at 1; apply eq_sym.
(* Goal: @eq R (Rmult (Z2R (Zceil (Rmult (Rminus x y) (Fcore_Raux.bpow beta (Z.opp (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) (Rmult (Z2R mx) (Fcore_Raux.bpow beta (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
    apply Rmult_eq_compat_r.
(* Goal: @eq R (Z2R (Zceil (Rmult (Rminus x y) (Fcore_Raux.bpow beta (Z.opp (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Z2R mx) *)
    apply f_equal.
(* Goal: @eq Z (Zceil (Rmult (Rminus x y) (Fcore_Raux.bpow beta (Z.opp (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) mx *)
    rewrite Fx at 1.
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rmult (Rminus (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))))) *)
    rewrite Rmult_minus_distr_r.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    bpow_simplify.
(* Goal: @eq Z (Zceil (Rminus (Z2R mx) (Rmult y (Fcore_Raux.bpow beta (Z.opp (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) mx *)
    apply Zceil_imp.
(* Goal: and (Rle (Fcore_Raux.bpow beta (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH))) x'') (Rlt x'' (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) *)
    split.
    - unfold Zminus; rewrite Z2R_plus.
(* Goal: Rlt (Rplus a (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta a (Fcore_Raux.ln_beta beta a)))))) (Rplus a (ulp beta fexp1 a)) *)
      apply Rplus_lt_compat_l.
(* Goal: Rlt (Z2R (Z.opp (Zpos xH))) (Ropp (Rmult y (Fcore_Raux.bpow beta (Z.opp (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) *)
      apply Ropp_lt_contravar; simpl.
      apply (Rmult_lt_reg_r (bpow (fexp (ln_beta x))));
        [now apply bpow_gt_0|].
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
      rewrite Rmult_1_l; bpow_simplify.
(* Goal: Rlt y (Fcore_Raux.bpow beta (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) *)
      apply Rlt_le_trans with (bpow (ln_beta y)).
      + rewrite <- Rabs_right at 1; [|now apply Rle_ge; apply Rlt_le].
(* Goal: Rlt (Rabs (sqrt x)) (Fcore_Raux.bpow beta (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) *)
        apply bpow_ln_beta_gt.
      + apply bpow_le.
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
        omega.
    - rewrite <- (Rplus_0_r (Z2R _)) at 2.
(* Goal: Rle (Rplus (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))) (Rplus (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH)))) *)
      apply Rplus_le_compat_l.
      rewrite <- Ropp_0; apply Ropp_le_contravar.
      rewrite <- (Rmult_0_r y).
(* Goal: Rle (Rmult y (IZR Z0)) (Rmult y (Fcore_Raux.bpow beta (Z.opp (fexp (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH)))))) *)
      apply Rmult_le_compat_l; [now apply Rlt_le|].
      now apply bpow_ge_0. }
(* Goal: Rlt (Rplus (Rminus (round beta fexp1 Zceil (Rminus x y)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y)))) (Rminus (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y))) (Rminus x y))) (Rplus (Rminus x y) (Rminus (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y))) (Rminus x y))) *)
  rewrite Rxy; ring_simplify.
(* Goal: Rle y y *)
  apply Rle_refl.
- (* x <= bpow (ln_beta x - 1) *)
  assert (Xpow : x = bpow (ln_beta x - 1)).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
  { apply Rle_antisym; [exact Hx|].
(* Goal: and (Rle (Fcore_Raux.bpow beta (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH))) x) (Rlt x (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) *)
    destruct (ln_beta x) as (ex, Hex); simpl.
    rewrite <- (Rabs_right x); [|now apply Rle_ge; apply Rlt_le].
(* Goal: and (Rle (Fcore_Raux.bpow beta (Z.sub ex (Zpos xH))) (Rabs x)) (Rlt (Rabs x) (Fcore_Raux.bpow beta ex)) *)
    apply Hex.
    now apply Rgt_not_eq. }
  assert (Lxy : (ln_beta (x - y) = ln_beta x - 1 :> Z)%Z).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
  { apply Zle_antisym.
    - apply ln_beta_le_bpow.
      + apply Rminus_eq_contra.
(* Goal: not (@eq R x y) *)
        now intro Hx'; rewrite Hx' in Hxy; apply (Rlt_irrefl y).
      + rewrite Rabs_right; lra.
    - apply (ln_beta_minus_lb beta x y Px Py).
      omega. }
  assert (Hfx1 : (fexp (ln_beta x - 1) < ln_beta x - 1)%Z);
    [now apply (valid_exp_large fexp (ln_beta y)); [|omega]|].
  assert (Rxy : round beta fexp Zceil (x - y) <= x).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
  { rewrite Xpow at 2.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) (IZR Z0) *)
    unfold round, F2R, scaled_mantissa, canonic_exp; simpl.
(* Goal: Z.le (fexp1 (ln_beta_val beta (Rplus x y) (Fcore_Raux.ln_beta beta (Rplus x y)))) (ln_beta_val beta (Rplus x y) (Fcore_Raux.ln_beta beta (Rplus x y))) *)
    rewrite Lxy.
    apply (Rmult_le_reg_r (bpow (- fexp (ln_beta x - 1)%Z)));
      [now apply bpow_gt_0|].
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    bpow_simplify.
    rewrite <- (Z2R_Zpower beta (_ - _ - _)); [|omega].
(* Goal: Rle (Z2R (Zceil (Rmult (Rminus x y) (Fcore_Raux.bpow beta (Z.opp (fexp (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH)))))))) (Z2R (Z.pow (radix_val beta) (Z.sub (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (fexp (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH)))) (Zpos xH)))) *)
    apply Z2R_le.
(* Goal: Z.le (Zceil (Rmult (Rminus x y) (Fcore_Raux.bpow beta (Z.opp (fexp (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH))))))) (Z.pow (radix_val beta) (Z.sub (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (fexp (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH)))) (Zpos xH))) *)
    apply Zceil_glb.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Z2R (Z.pow (radix_val beta) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    rewrite Z2R_Zpower; [|omega].
(* Goal: Rle (Rmult (Rminus x y) (Fcore_Raux.bpow beta (Z.opp (fexp (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH)))))) (Fcore_Raux.bpow beta (Z.sub (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (fexp (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH)))) (Zpos xH))) *)
    rewrite Xpow at 1.
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rmult (Rminus (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))))) *)
    rewrite Rmult_minus_distr_r.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    bpow_simplify.
    rewrite <- (Rplus_0_r (bpow _)) at 2.
(* Goal: Rle (Rplus (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))) (Rplus (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH)))) *)
    apply Rplus_le_compat_l.
    rewrite <- Ropp_0; apply Ropp_le_contravar.
    rewrite <- (Rmult_0_r y).
(* Goal: Rle (Rmult y (IZR Z0)) (Rmult y (Fcore_Raux.bpow beta (Z.opp (fexp (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH)))))) *)
    apply Rmult_le_compat_l; [now apply Rlt_le|].
    now apply bpow_ge_0. }
(* Goal: forall _ : Rlt (Rplus (Rplus x' (Rmult (Rinv (IZR (Zpos (xO xH)))) u1)) (Rmult (Rinv (IZR (Zpos (xO xH)))) u2)) x, Rlt (Rplus (Rminus (Rplus x' u1) (Rmult (Rinv (IZR (Zpos (xO xH)))) u1)) (Rmult (Rinv (IZR (Zpos (xO xH)))) u2)) x *)
  lra.
Qed.

(* ln_beta y <= fexp1 (ln_beta x) - 2 :
 * ln_beta y <= fexp1 (ln_beta (x - y)) - 2 :
 * double_round_gt_mid applies. *)
Lemma double_round_minus_aux2 :
  forall (fexp1 fexp2 : Z -> Z),
  Valid_exp fexp1 -> Valid_exp fexp2 ->
  forall (choice1 choice2 : Z -> bool),
  double_round_plus_hyp fexp1 fexp2 ->
  forall x y,
  0 < y -> y < x ->
  (ln_beta y <= fexp1 (ln_beta x) - 2)%Z ->
  (ln_beta y <= fexp1 (ln_beta (x - y)) - 2)%Z ->
  generic_format beta fexp1 x ->
  generic_format beta fexp1 y ->
  double_round_eq fexp1 fexp2 choice1 choice2 (x - y).
Proof.
(* Goal: Rlt (Rinv (Z2R (Z.mul (radix_val beta) (radix_val beta)))) (Rinv (IZR (Zpos (xO xH)))) *)
assert (Hbeta : (2 <= beta)%Z).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ destruct beta as (beta_val,beta_prop).
  now apply Zle_bool_imp_le. }
(* Goal: forall (fexp1 fexp2 : forall _ : Z, Z) (_ : Valid_exp fexp1) (_ : Valid_exp fexp2) (choice1 choice2 : forall _ : Z, bool) (_ : double_round_plus_hyp fexp1 fexp2) (x y : R) (_ : Rlt (IZR Z0) y) (_ : Rlt y x) (_ : Z.le (ln_beta_val beta y (Fcore_Raux.ln_beta beta y)) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Zpos (xO xH)))) (_ : Z.le (ln_beta_val beta y (Fcore_Raux.ln_beta beta y)) (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos (xO xH)))) (_ : generic_format beta fexp1 x) (_ : generic_format beta fexp1 y), double_round_eq fexp1 fexp2 choice1 choice2 (Rminus x y) *)
intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x y Py Hxy Hly Hly' Fx Fy.
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rminus x y) *)
assert (Px := Rlt_trans 0 y x Py Hxy).
(* Goal: forall _ : not (@eq R x R0), Z.le (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) *)
(* Goal: generic_format beta fexp1 x *)
destruct Hexp as (_,(_,(_,Hexp4))).
assert (Hf2 : (fexp2 (ln_beta x) <= fexp1 (ln_beta x))%Z);
  [now apply Hexp4; omega|].
assert (Hfx : (fexp1 (ln_beta x) < ln_beta x)%Z);
  [now apply ln_beta_generic_gt; [|apply Rgt_not_eq|]|].
assert (Bpow2 : bpow (- 2) <= / 2 * / 2).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ replace (/2 * /2) with (/4) by field.
(* Goal: Rle (Fcore_Raux.bpow beta (Zneg (xO xH))) (Rinv (IZR (Zpos (xO (xO xH))))) *)
  rewrite (bpow_opp _ 2).
(* Goal: Rle (Rinv (Z2R (radix_val beta))) (Rinv (IZR (Zpos (xO xH)))) *)
  apply Rinv_le; [lra|].
  apply (Z2R_le (2 * 2) (beta * (beta * 1))).
(* Goal: @eq R (Rplus (Rmult (Z2R (Zfloor (scaled_mantissa beta fexp2 rd))) (Fcore_Raux.bpow beta (canonic_exp beta fexp2 x))) (Rmult (Rmult (Z2R n) (Rinv (Z2R (Z.mul (radix_val beta) (Zpos xH))))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) x *)
  rewrite Zmult_1_r.
  now apply Zmult_le_compat; omega. }
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rminus x y) *)
assert (Ly : y < bpow (ln_beta y)).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ apply Rabs_lt_inv.
  apply bpow_ln_beta_gt. }
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
unfold double_round_eq.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rminus x y))) (round beta fexp1 (Znearest choice1) (Rminus x y)) *)
apply double_round_gt_mid.
(* Goal: Valid_exp fexp1 *)
- exact Vfexp1.
- exact Vfexp2.
- lra.
- apply Hexp4; omega.
- assert (fexp1 (ln_beta (x - y)) < ln_beta (x - y))%Z; [|omega].
  apply (valid_exp_large fexp1 (ln_beta x - 1)).
  + apply (valid_exp_large fexp1 (ln_beta y)); [|omega].
(* Goal: Z.lt (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) *)
    now apply ln_beta_generic_gt; [|apply Rgt_not_eq|].
  + now apply ln_beta_minus_lb; [| |omega].
- unfold midp'.
  apply (Rplus_lt_reg_r (/ 2 * ulp beta fexp1 (x - y) - (x - y))).
(* Goal: Rlt (Rplus (Rminus (round beta fexp1 Zceil (Rminus x y)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y)))) (Rminus (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y))) (Rminus x y))) (Rplus (Rminus x y) (Rminus (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y))) (Rminus x y))) *)
  ring_simplify.
  replace (_ + _) with (round beta fexp1 Zceil (x - y) - (x - y)) by ring.
  apply Rlt_le_trans with (bpow (fexp1 (ln_beta (x - y)) - 2)).
  + apply Rle_lt_trans with y;
    [now apply double_round_minus_aux2_aux; try assumption; omega|].
(* Goal: Rlt y (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (ulp beta fexp1 (Rminus x y)) (ulp beta fexp2 (Rminus x y)))) *)
    apply (Rlt_le_trans _ _ _ Ly).
(* Goal: Rle (Fcore_Raux.bpow beta (ln_beta_val beta y (Fcore_Raux.ln_beta beta y))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) *)
    now apply bpow_le.
  + rewrite ulp_neq_0;[idtac|now apply sym_not_eq, Rlt_not_eq, Rgt_minus].
(* Goal: Rle (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (Fcore_Raux.bpow beta (canonic_exp beta fexp1 (Rminus x y))) (Fcore_Raux.bpow beta (canonic_exp beta fexp2 (Rminus x y))))) *)
    unfold canonic_exp.
    replace (_ - 2)%Z with (fexp1 (ln_beta (x - y)) - 1 - 1)%Z by ring.
(* Goal: Rlt x (Fcore_Raux.bpow beta (Z.add (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))))) *)
    unfold Zminus at 1; rewrite bpow_plus.
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))) (Fcore_Raux.bpow beta (Z.opp (Zpos xH)))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))) *)
    rewrite Rmult_comm.
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (Zneg xH)) (pow u1 (S (S O)))) (Rmult (Rinv (IZR (Zpos (xO (xO xH))))) (Rplus (pow u2 (S (S O))) (pow u1 (S (S O))))) *)
    apply Rmult_le_compat.
    * now apply bpow_ge_0.
    * now apply bpow_ge_0.
    * unfold Fcore_Raux.bpow, Z.pow_pos; simpl.
(* Goal: Rle (Rinv (Z2R (Z.mul (radix_val beta) (Zpos xH)))) (Rinv (IZR (Zpos (xO xH)))) *)
      rewrite Zmult_1_r; apply Rinv_le.
(* Goal: forall _ : Rlt (Rplus (Rplus x' (Rmult (Rinv (IZR (Zpos (xO xH)))) u1)) (Rmult (Rinv (IZR (Zpos (xO xH)))) u2)) x, Rlt (Rplus (Rminus (Rplus x' u1) (Rmult (Rinv (IZR (Zpos (xO xH)))) u1)) (Rmult (Rinv (IZR (Zpos (xO xH)))) u2)) x *)
      lra.
(* Goal: Rle (Z2R (Zceil (Rmult (Rminus x y) (Fcore_Raux.bpow beta (Z.opp (fexp (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH)))))))) (Z2R (Z.pow (radix_val beta) (Z.sub (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (fexp (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH)))) (Zpos xH)))) *)
      now change 2 with (Z2R 2); apply Z2R_le.
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
    * apply bpow_le; omega.
- intro Hf2'.
(* Goal: Rlt (Rplus (midp' fexp1 (Rminus x y)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 (Rminus x y)))) (Rminus x y) *)
  unfold midp'.
  apply (Rplus_lt_reg_r (/ 2 * ulp beta fexp1 (x - y) - (x - y)
                         - / 2 * ulp beta fexp2 (x - y))).
(* Goal: Rlt (Rplus (Rminus (round beta fexp1 Zceil (Rminus x y)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y)))) (Rminus (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y))) (Rminus x y))) (Rplus (Rminus x y) (Rminus (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y))) (Rminus x y))) *)
  ring_simplify.
  replace (_ + _) with (round beta fexp1 Zceil (x - y) - (x - y)) by ring.
  apply Rle_lt_trans with y;
    [now apply double_round_minus_aux2_aux; try assumption; omega|].
(* Goal: Rlt y (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (ulp beta fexp1 (Rminus x y)) (ulp beta fexp2 (Rminus x y)))) *)
  apply (Rlt_le_trans _ _ _ Ly).
  apply Rle_trans with (bpow (fexp1 (ln_beta (x - y)) - 2));
    [now apply bpow_le|].
  replace (_ - 2)%Z with (fexp1 (ln_beta (x - y)) - 1 - 1)%Z by ring.
(* Goal: Rlt x (Fcore_Raux.bpow beta (Z.add (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))))) *)
  unfold Zminus at 1; rewrite bpow_plus.
  rewrite <- Rmult_minus_distr_l.
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (Zneg xH)) (pow u1 (S (S O)))) (Rmult (Rinv (IZR (Zpos (xO (xO xH))))) (Rplus (pow u2 (S (S O))) (pow u1 (S (S O))))) *)
  rewrite Rmult_comm; apply Rmult_le_compat.
  + apply bpow_ge_0.
  + apply bpow_ge_0.
  + unfold Fcore_Raux.bpow, Z.pow_pos; simpl.
(* Goal: Rle (Rinv (Z2R (radix_val beta))) (Rinv (IZR (Zpos (xO xH)))) *)
    rewrite Zmult_1_r; apply Rinv_le; [lra|].
(* Goal: Rle (Z2R (Zceil (Rmult (Rminus x y) (Fcore_Raux.bpow beta (Z.opp (fexp (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH)))))))) (Z2R (Z.pow (radix_val beta) (Z.sub (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (fexp (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH)))) (Zpos xH)))) *)
    now change 2 with (Z2R 2); apply Z2R_le.
  + rewrite 2!ulp_neq_0; try now apply Rgt_not_eq, Rgt_minus.
(* Goal: Rle (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (Fcore_Raux.bpow beta (canonic_exp beta fexp1 (Rminus x y))) (Fcore_Raux.bpow beta (canonic_exp beta fexp2 (Rminus x y))))) *)
    unfold canonic_exp.
    apply (Rplus_le_reg_r (bpow (fexp2 (ln_beta (x - y))))); ring_simplify.
    apply Rle_trans with (2 * bpow (fexp1 (ln_beta (x - y)) - 1)).
    * replace (2 * bpow (fexp1 (ln_beta (x - y)) - 1)) with (bpow (fexp1 (ln_beta (x - y)) - 1) + bpow (fexp1 (ln_beta (x - y)) - 1)) by ring.
(* Goal: Rle (Rplus (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))) (Rplus (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH)))) *)
      apply Rplus_le_compat_l.
(* Goal: Rle (Fcore_Raux.bpow beta (ln_beta_val beta y (Fcore_Raux.ln_beta beta y))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) *)
      now apply bpow_le.
    * unfold Zminus; rewrite bpow_plus.
(* Goal: Rle (Rmult (IZR (Zpos (xO xH))) (Rmult (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))) (Fcore_Raux.bpow beta (Z.opp (Zpos xH))))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))) *)
      rewrite Rmult_comm; rewrite Rmult_assoc.
      rewrite <- Rmult_1_r.
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))) (Rmult (Fcore_Raux.bpow beta (Z.opp (Zpos xH))) (IZR (Zpos (xO xH))))) (Rmult (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))) (IZR (Zpos xH))) *)
      apply Rmult_le_compat_l; [now apply bpow_ge_0|].
(* Goal: Rle (Fcore_Raux.bpow beta (Zneg xH)) (Rinv (IZR (Zpos (xI xH)))) *)
      unfold Fcore_Raux.bpow, Z.pow_pos; simpl.
(* Goal: @eq R (Rplus (Rmult (Z2R (Zfloor (scaled_mantissa beta fexp2 rd))) (Fcore_Raux.bpow beta (canonic_exp beta fexp2 x))) (Rmult (Rmult (Z2R n) (Rinv (Z2R (Z.mul (radix_val beta) (Zpos xH))))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) x *)
      rewrite Zmult_1_r.
(* Goal: Rle (Rmult (Rinv (Z2R (radix_val beta))) (IZR (Zpos (xO xH)))) (IZR (Zpos xH)) *)
      apply Z2R_le, Rinv_le in Hbeta.
(* Goal: Rle (Rmult (Rinv (Z2R (radix_val beta))) (IZR (Zpos (xO xH)))) (IZR (Zpos xH)) *)
(* Goal: Rlt (IZR Z0) (Z2R (Zpos (xO xH))) *)
      simpl in Hbeta.
(* Goal: forall _ : Rlt (Rplus (Rplus x' (Rmult (Rinv (IZR (Zpos (xO xH)))) u1)) (Rmult (Rinv (IZR (Zpos (xO xH)))) u2)) x, Rlt (Rplus (Rminus (Rplus x' u1) (Rmult (Rinv (IZR (Zpos (xO xH)))) u1)) (Rmult (Rinv (IZR (Zpos (xO xH)))) u2)) x *)
      lra.
(* Goal: Rlt (IZR Z0) (Z2R (Zpos (xO xH))) *)
      apply Rlt_0_2.
Qed.

(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
(* double_round_minus_aux{0,1,2} together *)
Lemma double_round_minus_aux3 :
  forall (fexp1 fexp2 : Z -> Z),
  Valid_exp fexp1 -> Valid_exp fexp2 ->
  forall (choice1 choice2 : Z -> bool),
  double_round_plus_hyp fexp1 fexp2 ->
  forall x y,
  0 < y -> y <= x ->
  generic_format beta fexp1 x ->
  generic_format beta fexp1 y ->
  double_round_eq fexp1 fexp2 choice1 choice2 (x - y).
Proof.
(* Goal: forall (fexp1 fexp2 : forall _ : Z, Z) (_ : Valid_exp fexp1) (_ : Valid_exp fexp2) (choice1 choice2 : forall _ : Z, bool) (_ : double_round_plus_hyp fexp1 fexp2) (x y : R) (_ : Rlt (IZR Z0) y) (_ : Rle y x) (_ : generic_format beta fexp1 x) (_ : generic_format beta fexp1 y), double_round_eq fexp1 fexp2 choice1 choice2 (Rminus x y) *)
intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x y Py Hyx Fx Fy.
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rminus x y) *)
assert (Px := Rlt_le_trans 0 y x Py Hyx).
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
unfold double_round_eq.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rminus x y))) (round beta fexp1 (Znearest choice1) (Rminus x y)) *)
destruct (Req_dec y x) as [Hy|Hy].
- (* y = x *)
  rewrite Hy; replace (x - x) with 0 by ring.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (IZR Z0))) (round beta fexp1 (Znearest choice1) (IZR Z0)) *)
  rewrite round_0.
  + reflexivity.
  + now apply valid_rnd_N.
- (* y < x *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rminus x y))) (round beta fexp1 (Znearest choice1) (Rminus x y)) *)
  assert (Hyx' : y < x); [lra|].
  destruct (Zle_or_lt (ln_beta y) (fexp1 (ln_beta x) - 2)) as [Hly|Hly].
  + (* ln_beta y <= fexp1 (ln_beta x) - 2 *)
    destruct (Zle_or_lt (ln_beta y) (fexp1 (ln_beta (x - y)) - 2))
      as [Hly'|Hly'].
    * (* ln_beta y <= fexp1 (ln_beta (x - y)) - 2 *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rminus x y))) (round beta fexp1 (Znearest choice1) (Rminus x y)) *)
      now apply double_round_minus_aux2.
    * (* fexp1 (ln_beta (x - y)) - 2 < ln_beta y *)
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
      { rewrite (round_generic beta fexp2).
        - reflexivity.
        - now apply valid_rnd_N.
        - assert (Hf1 : (fexp1 (ln_beta (x - y)) - 1 <= ln_beta y)%Z); [omega|].
          now apply (double_round_minus_aux1 fexp1). }
  + rewrite (round_generic beta fexp2).
    * reflexivity.
    * now apply valid_rnd_N.
    * assert (Hf1 : (fexp1 (ln_beta x) - 1 <= ln_beta y)%Z); [omega|].
(* Goal: generic_format beta fexp2 (Rminus x y) *)
      now apply (double_round_minus_aux0 fexp1).
Qed.

Lemma double_round_minus_aux :
  forall (fexp1 fexp2 : Z -> Z),
  Valid_exp fexp1 -> Valid_exp fexp2 ->
  forall (choice1 choice2 : Z -> bool),
  double_round_plus_hyp fexp1 fexp2 ->
  forall x y,
  0 <= x -> 0 <= y ->
  generic_format beta fexp1 x ->
  generic_format beta fexp1 y ->
  double_round_eq fexp1 fexp2 choice1 choice2 (x - y).
Proof.
(* Goal: forall (fexp1 fexp2 : forall _ : Z, Z) (_ : Valid_exp fexp1) (_ : Valid_exp fexp2) (choice1 choice2 : forall _ : Z, bool) (_ : double_round_plus_hyp fexp1 fexp2) (x y : R) (_ : Rle (IZR Z0) x) (_ : Rle (IZR Z0) y) (_ : generic_format beta fexp1 x) (_ : generic_format beta fexp1 y), double_round_eq fexp1 fexp2 choice1 choice2 (Rminus x y) *)
intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x y Nnx Nny Fx Fy.
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
unfold double_round_eq.
(* Goal: @eq R (sqrt x) (IZR Z0) *)
destruct (Req_dec x 0) as [Zx|Nzx].
- (* x = 0 *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rminus x y))) (round beta fexp1 (Znearest choice1) (Rminus x y)) *)
  rewrite Zx; unfold Rminus; rewrite Rplus_0_l.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Ropp (Rmult x (Rinv (Ropp y)))))) (round beta fexp1 (Znearest choice1) (Ropp (Rmult x (Rinv (Ropp y))))) *)
  do 3 rewrite round_N_opp.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)) (round beta fexp1 (Znearest choice1) x) *)
  rewrite (round_generic beta fexp2).
  * reflexivity.
  * now apply valid_rnd_N.
  * apply (generic_inclusion_ln_beta beta fexp1).
(* Goal: forall _ : not (@eq R x R0), Z.le (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) *)
(* Goal: generic_format beta fexp1 x *)
    destruct Hexp as (_,(_,(_,Hexp4))).
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
    now intros _; apply Hexp4; omega.
(* Goal: generic_format beta fexp1 y *)
    exact Fy.
- (* x <> 0 *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rminus x y))) (round beta fexp1 (Znearest choice1) (Rminus x y)) *)
  destruct (Req_dec y 0) as [Zy|Nzy].
  + (* y = 0 *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rminus x y))) (round beta fexp1 (Znearest choice1) (Rminus x y)) *)
    rewrite Zy; unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)) (round beta fexp1 (Znearest choice1) x) *)
    rewrite (round_generic beta fexp2).
    * reflexivity.
    * now apply valid_rnd_N.
    * apply (generic_inclusion_ln_beta beta fexp1).
(* Goal: forall _ : not (@eq R x R0), Z.le (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) *)
(* Goal: generic_format beta fexp1 x *)
      destruct Hexp as (_,(_,(_,Hexp4))).
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
      now intros _; apply Hexp4; omega.
(* Goal: generic_format beta fexp1 x *)
      exact Fx.
  + (* y <> 0 *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rminus x y))) (round beta fexp1 (Znearest choice1) (Rminus x y)) *)
    assert (Px : 0 < x); [lra|].
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rminus x y))) (round beta fexp1 (Znearest choice1) (Rminus x y)) *)
    assert (Py : 0 < y); [lra|].
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rminus x y))) (round beta fexp1 (Znearest choice1) (Rminus x y)) *)
    destruct (Rlt_or_le x y) as [H|H].
    * (* x < y *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rminus x y))) (round beta fexp1 (Znearest choice1) (Rminus x y)) *)
      apply Rlt_le in H.
      replace (x - y) with (- (y - x)) by ring.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Ropp (Rmult x (Rinv (Ropp y)))))) (round beta fexp1 (Znearest choice1) (Ropp (Rmult x (Rinv (Ropp y))))) *)
      do 3 rewrite round_N_opp.
(* Goal: @eq R (Ropp (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (round beta fexp2 (Znearest (fun t : Z => negb (choice2 (Z.opp (Z.add t (Zpos xH)))))) (Rmult x (Rinv (Ropp y)))))) (Ropp (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (Rmult x (Rinv (Ropp y))))) *)
      apply Ropp_eq_compat.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rminus x y))) (round beta fexp1 (Znearest choice1) (Rminus x y)) *)
      now apply double_round_minus_aux3.
    * (* y <= x *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rminus x y))) (round beta fexp1 (Znearest choice1) (Rminus x y)) *)
      now apply double_round_minus_aux3.
Qed.

Lemma double_round_plus :
  forall (fexp1 fexp2 : Z -> Z),
  Valid_exp fexp1 -> Valid_exp fexp2 ->
  forall (choice1 choice2 : Z -> bool),
  double_round_plus_hyp fexp1 fexp2 ->
  forall x y,
  generic_format beta fexp1 x ->
  generic_format beta fexp1 y ->
  double_round_eq fexp1 fexp2 choice1 choice2 (x + y).
Proof.
(* Goal: forall (fexp1 fexp2 : forall _ : Z, Z) (_ : Valid_exp fexp1) (_ : Valid_exp fexp2) (choice1 choice2 : forall _ : Z, bool) (_ : double_round_plus_hyp fexp1 fexp2) (x y : R) (_ : generic_format beta fexp1 x) (_ : generic_format beta fexp1 y), double_round_eq fexp1 fexp2 choice1 choice2 (Rminus x y) *)
intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x y Fx Fy.
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
unfold double_round_eq.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rplus x y))) (round beta fexp1 (Znearest choice1) (Rplus x y)) *)
destruct (Rlt_or_le x 0) as [Sx|Sx]; destruct (Rlt_or_le y 0) as [Sy|Sy].
- (* x < 0, y < 0 *)
  replace (x + y) with (- (- x - y)); [|ring].
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Ropp (Rmult x (Rinv (Ropp y)))))) (round beta fexp1 (Znearest choice1) (Ropp (Rmult x (Rinv (Ropp y))))) *)
  do 3 rewrite round_N_opp.
(* Goal: @eq R (Ropp (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (round beta fexp2 (Znearest (fun t : Z => negb (choice2 (Z.opp (Z.add t (Zpos xH)))))) (Rmult x (Rinv (Ropp y)))))) (Ropp (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (Rmult x (Rinv (Ropp y))))) *)
  apply Ropp_eq_compat.
  assert (Px : 0 <= - x); [lra|].
  assert (Py : 0 <= - y); [lra|].
(* Goal: @eq R (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (round beta fexp2 (Znearest (fun t : Z => negb (choice2 (Z.opp (Z.add t (Zpos xH)))))) (Rdiv (Ropp x) y))) (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (Rdiv (Ropp x) y)) *)
  apply generic_format_opp in Fx.
(* Goal: @eq R (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (round beta fexp2 (Znearest (fun t : Z => negb (choice2 (Z.opp (Z.add t (Zpos xH)))))) (Rmult x (Rinv (Ropp y))))) (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (Rmult x (Rinv (Ropp y)))) *)
  apply generic_format_opp in Fy.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rplus x y))) (round beta fexp1 (Znearest choice1) (Rplus x y)) *)
  now apply double_round_plus_aux.
- (* x < 0, 0 <= y *)
  replace (x + y) with (y - (- x)); [|ring].
  assert (Px : 0 <= - x); [lra|].
(* Goal: @eq R (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (round beta fexp2 (Znearest (fun t : Z => negb (choice2 (Z.opp (Z.add t (Zpos xH)))))) (Rdiv (Ropp x) y))) (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (Rdiv (Ropp x) y)) *)
  apply generic_format_opp in Fx.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rminus x (Ropp y)))) (round beta fexp1 (Znearest choice1) (Rminus x (Ropp y))) *)
  now apply double_round_minus_aux.
- (* 0 <= x, y < 0 *)
  replace (x + y) with (x - (- y)); [|ring].
  assert (Py : 0 <= - y); [lra|].
(* Goal: @eq R (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (round beta fexp2 (Znearest (fun t : Z => negb (choice2 (Z.opp (Z.add t (Zpos xH)))))) (Rmult x (Rinv (Ropp y))))) (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (Rmult x (Rinv (Ropp y)))) *)
  apply generic_format_opp in Fy.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rminus x (Ropp y)))) (round beta fexp1 (Znearest choice1) (Rminus x (Ropp y))) *)
  now apply double_round_minus_aux.
- (* 0 <= x, 0 <= y *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rplus x y))) (round beta fexp1 (Znearest choice1) (Rplus x y)) *)
  now apply double_round_plus_aux.
Qed.

Lemma double_round_minus :
  forall (fexp1 fexp2 : Z -> Z),
  Valid_exp fexp1 -> Valid_exp fexp2 ->
  forall (choice1 choice2 : Z -> bool),
  double_round_plus_hyp fexp1 fexp2 ->
  forall x y,
  generic_format beta fexp1 x ->
  generic_format beta fexp1 y ->
  double_round_eq fexp1 fexp2 choice1 choice2 (x - y).
Proof.
(* Goal: forall (fexp1 fexp2 : forall _ : Z, Z) (_ : Valid_exp fexp1) (_ : Valid_exp fexp2) (choice1 choice2 : forall _ : Z, bool) (_ : double_round_plus_hyp fexp1 fexp2) (x y : R) (_ : generic_format beta fexp1 x) (_ : generic_format beta fexp1 y), double_round_eq fexp1 fexp2 choice1 choice2 (Rminus x y) *)
intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x y Fx Fy.
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rminus x y) *)
unfold Rminus.
(* Goal: @eq R (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (round beta fexp2 (Znearest (fun t : Z => negb (choice2 (Z.opp (Z.add t (Zpos xH)))))) (Rmult x (Rinv (Ropp y))))) (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (Rmult x (Rinv (Ropp y)))) *)
apply generic_format_opp in Fy.
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rplus x (Ropp y)) *)
now apply double_round_plus.
Qed.

Section Double_round_plus_FLX.

Import Fcore_FLX.

Variable prec : Z.
Variable prec' : Z.

(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
Context { prec_gt_0_ : Prec_gt_0 prec }.
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
Context { prec_gt_0_' : Prec_gt_0 prec' }.

Lemma FLX_double_round_plus_hyp :
  (2 * prec + 1 <= prec')%Z ->
  double_round_plus_hyp (FLX_exp prec) (FLX_exp prec').
Proof.
(* Goal: forall _ : Z.le (Z.mul (Zpos (xO xH)) prec) prec', double_round_div_hyp (FLX_exp prec) (FLX_exp prec') *)
intros Hprec.
(* Goal: double_round_div_hyp (FLX_exp prec) (FLX_exp prec') *)
unfold FLX_exp.
unfold double_round_plus_hyp; split; [|split; [|split]];
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
intros ex ey; try omega.
(* Goal: double_round_div_hyp (fun e : Z => if Z.ltb (Z.sub e prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub e prec) (fun e : Z => if Z.ltb (Z.sub e prec') emin' then Z.sub (Z.add emin' prec') (Zpos xH) else Z.sub e prec') *)
unfold Prec_gt_0 in prec_gt_0_.
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
omega.
Qed.

Theorem double_round_plus_FLX :
  forall choice1 choice2,
  (2 * prec + 1 <= prec')%Z ->
  forall x y,
  FLX_format beta prec x -> FLX_format beta prec y ->
  double_round_eq (FLX_exp prec) (FLX_exp prec') choice1 choice2 (x + y).
Proof.
(* Goal: forall (choice1 choice2 : forall _ : Z, bool) (_ : Z.le (Z.add (Z.mul (Zpos (xO xH)) prec) (Zpos xH)) prec') (x y : R) (_ : FLX_format beta prec x) (_ : FLX_format beta prec y), double_round_eq (FLX_exp prec) (FLX_exp prec') choice1 choice2 (Rminus x y) *)
intros choice1 choice2 Hprec x y Fx Fy.
(* Goal: double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec') choice1 choice2 (Rplus x y) *)
apply double_round_plus.
- now apply FLX_exp_valid.
- now apply FLX_exp_valid.
- now apply FLX_double_round_plus_hyp.
- now apply generic_format_FLX.
- now apply generic_format_FLX.
Qed.

Theorem double_round_minus_FLX :
  forall choice1 choice2,
  (2 * prec + 1 <= prec')%Z ->
  forall x y,
  FLX_format beta prec x -> FLX_format beta prec y ->
  double_round_eq (FLX_exp prec) (FLX_exp prec') choice1 choice2 (x - y).
Proof.
(* Goal: forall (choice1 choice2 : forall _ : Z, bool) (_ : Z.le (Z.add (Z.mul (Zpos (xO xH)) prec) (Zpos xH)) prec') (x y : R) (_ : FLX_format beta prec x) (_ : FLX_format beta prec y), double_round_eq (FLX_exp prec) (FLX_exp prec') choice1 choice2 (Rminus x y) *)
intros choice1 choice2 Hprec x y Fx Fy.
(* Goal: double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec') choice1 choice2 (Rminus x y) *)
apply double_round_minus.
- now apply FLX_exp_valid.
- now apply FLX_exp_valid.
- now apply FLX_double_round_plus_hyp.
- now apply generic_format_FLX.
- now apply generic_format_FLX.
Qed.

End Double_round_plus_FLX.

Section Double_round_plus_FLT.

Import Fcore_FLX.
Import Fcore_FLT.

Variable emin prec : Z.
Variable emin' prec' : Z.

(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
Context { prec_gt_0_ : Prec_gt_0 prec }.
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
Context { prec_gt_0_' : Prec_gt_0 prec' }.

Lemma FLT_double_round_plus_hyp :
  (emin' <= emin)%Z -> (2 * prec + 1 <= prec')%Z ->
  double_round_plus_hyp (FLT_exp emin prec) (FLT_exp emin' prec').
Proof.
(* Goal: forall (_ : Z.le (Z.add emin' prec') (Z.sub emin (Zpos xH))) (_ : Z.le (Z.mul (Zpos (xO xH)) prec) prec'), double_round_div_hyp (FTZ_exp emin prec) (FTZ_exp emin' prec') *)
intros Hemin Hprec.
(* Goal: double_round_div_hyp (FLT_exp emin prec) (FLT_exp emin' prec') *)
unfold FLT_exp.
(* Goal: double_round_plus_hyp (fun e : Z => if Z.ltb (Z.sub e prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub e prec) (fun e : Z => if Z.ltb (Z.sub e prec') emin' then Z.sub (Z.add emin' prec') (Zpos xH) else Z.sub e prec') *)
unfold double_round_plus_hyp; split; [|split; [|split]]; intros ex ey.
- generalize (Zmax_spec (ex + 1 - prec) emin).
  generalize (Zmax_spec (ex - prec') emin').
  generalize (Zmax_spec (ey - prec) emin).
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  omega.
- generalize (Zmax_spec (ex - 1 - prec) emin).
  generalize (Zmax_spec (ex - prec') emin').
  generalize (Zmax_spec (ey - prec) emin).
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  omega.
- generalize (Zmax_spec (ex - prec) emin).
  generalize (Zmax_spec (ex - prec') emin').
  generalize (Zmax_spec (ey - prec) emin).
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  omega.
- unfold Prec_gt_0 in prec_gt_0_.
  generalize (Zmax_spec (ex - prec') emin').
  generalize (Zmax_spec (ey - prec) emin).
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  omega.
Qed.

Theorem double_round_plus_FLT :
  forall choice1 choice2,
  (emin' <= emin)%Z -> (2 * prec + 1 <= prec')%Z ->
  forall x y,
  FLT_format beta emin prec x -> FLT_format beta emin prec y ->
  double_round_eq (FLT_exp emin prec) (FLT_exp emin' prec')
                  choice1 choice2 (x + y).
Proof.
(* Goal: forall (choice1 choice2 : forall _ : Z, bool) (_ : Z.le (Z.add emin' prec') (Z.add emin (Zpos xH))) (_ : Z.le (Z.add (Z.mul (Zpos (xO xH)) prec) (Zpos xH)) prec') (x y : R) (_ : FTZ_format beta emin prec x) (_ : FTZ_format beta emin prec y), double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec') choice1 choice2 (Rminus x y) *)
intros choice1 choice2 Hemin Hprec x y Fx Fy.
(* Goal: double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec') choice1 choice2 (Rplus x y) *)
apply double_round_plus.
- now apply FLT_exp_valid.
- now apply FLT_exp_valid.
- now apply FLT_double_round_plus_hyp.
- now apply generic_format_FLT.
- now apply generic_format_FLT.
Qed.

Theorem double_round_minus_FLT :
  forall choice1 choice2,
  (emin' <= emin)%Z -> (2 * prec + 1 <= prec')%Z ->
  forall x y,
  FLT_format beta emin prec x -> FLT_format beta emin prec y ->
  double_round_eq (FLT_exp emin prec) (FLT_exp emin' prec')
                  choice1 choice2 (x - y).
Proof.
(* Goal: forall (choice1 choice2 : forall _ : Z, bool) (_ : Z.le (Z.add emin' prec') (Z.add emin (Zpos xH))) (_ : Z.le (Z.add (Z.mul (Zpos (xO xH)) prec) (Zpos xH)) prec') (x y : R) (_ : FTZ_format beta emin prec x) (_ : FTZ_format beta emin prec y), double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec') choice1 choice2 (Rminus x y) *)
intros choice1 choice2 Hemin Hprec x y Fx Fy.
(* Goal: double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec') choice1 choice2 (Rminus x y) *)
apply double_round_minus.
- now apply FLT_exp_valid.
- now apply FLT_exp_valid.
- now apply FLT_double_round_plus_hyp.
- now apply generic_format_FLT.
- now apply generic_format_FLT.
Qed.

End Double_round_plus_FLT.

Section Double_round_plus_FTZ.

Import Fcore_FLX.
Import Fcore_FTZ.

Variable emin prec : Z.
Variable emin' prec' : Z.

(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
Context { prec_gt_0_ : Prec_gt_0 prec }.
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
Context { prec_gt_0_' : Prec_gt_0 prec' }.

Lemma FTZ_double_round_plus_hyp :
  (emin' + prec' <= emin + 1)%Z -> (2 * prec + 1 <= prec')%Z ->
  double_round_plus_hyp (FTZ_exp emin prec) (FTZ_exp emin' prec').
Proof.
(* Goal: forall (_ : Z.le (Z.add emin' prec') (Z.sub emin (Zpos xH))) (_ : Z.le (Z.mul (Zpos (xO xH)) prec) prec'), double_round_div_hyp (FTZ_exp emin prec) (FTZ_exp emin' prec') *)
intros Hemin Hprec.
(* Goal: double_round_div_hyp (FTZ_exp emin prec) (FTZ_exp emin' prec') *)
unfold FTZ_exp.
unfold Prec_gt_0 in *.
(* Goal: double_round_plus_hyp (fun e : Z => if Z.ltb (Z.sub e prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub e prec) (fun e : Z => if Z.ltb (Z.sub e prec') emin' then Z.sub (Z.add emin' prec') (Zpos xH) else Z.sub e prec') *)
unfold double_round_plus_hyp; split; [|split; [|split]]; intros ex ey.
- destruct (Z.ltb_spec (ex + 1 - prec) emin);
  destruct (Z.ltb_spec (ex - prec') emin');
  destruct (Z.ltb_spec (ey - prec) emin);
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  omega.
- destruct (Z.ltb_spec (ex - 1 - prec) emin);
  destruct (Z.ltb_spec (ex - prec') emin');
  destruct (Z.ltb_spec (ey - prec) emin);
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  omega.
- destruct (Z.ltb_spec (ex - prec) emin);
  destruct (Z.ltb_spec (ex - prec') emin');
  destruct (Z.ltb_spec (ey - prec) emin);
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  omega.
- destruct (Z.ltb_spec (ex - prec') emin');
  destruct (Z.ltb_spec (ey - prec) emin);
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  omega.
Qed.

Theorem double_round_plus_FTZ :
  forall choice1 choice2,
  (emin' + prec' <= emin + 1)%Z -> (2 * prec + 1 <= prec')%Z ->
  forall x y,
  FTZ_format beta emin prec x -> FTZ_format beta emin prec y ->
  double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec')
                  choice1 choice2 (x + y).
Proof.
(* Goal: forall (choice1 choice2 : forall _ : Z, bool) (_ : Z.le (Z.add emin' prec') (Z.add emin (Zpos xH))) (_ : Z.le (Z.add (Z.mul (Zpos (xO xH)) prec) (Zpos xH)) prec') (x y : R) (_ : FTZ_format beta emin prec x) (_ : FTZ_format beta emin prec y), double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec') choice1 choice2 (Rminus x y) *)
intros choice1 choice2 Hemin Hprec x y Fx Fy.
(* Goal: double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec') choice1 choice2 (Rplus x y) *)
apply double_round_plus.
- now apply FTZ_exp_valid.
- now apply FTZ_exp_valid.
- now apply FTZ_double_round_plus_hyp.
- now apply generic_format_FTZ.
- now apply generic_format_FTZ.
Qed.

Theorem double_round_minus_FTZ :
  forall choice1 choice2,
  (emin' + prec' <= emin + 1)%Z -> (2 * prec + 1 <= prec')%Z ->
  forall x y,
  FTZ_format beta emin prec x -> FTZ_format beta emin prec y ->
  double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec')
                  choice1 choice2 (x - y).
Proof.
(* Goal: forall (choice1 choice2 : forall _ : Z, bool) (_ : Z.le (Z.add emin' prec') (Z.add emin (Zpos xH))) (_ : Z.le (Z.add (Z.mul (Zpos (xO xH)) prec) (Zpos xH)) prec') (x y : R) (_ : FTZ_format beta emin prec x) (_ : FTZ_format beta emin prec y), double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec') choice1 choice2 (Rminus x y) *)
intros choice1 choice2 Hemin Hprec x y Fx Fy.
(* Goal: double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec') choice1 choice2 (Rminus x y) *)
apply double_round_minus.
- now apply FTZ_exp_valid.
- now apply FTZ_exp_valid.
- now apply FTZ_double_round_plus_hyp.
- now apply generic_format_FTZ.
- now apply generic_format_FTZ.
Qed.

End Double_round_plus_FTZ.

Section Double_round_plus_beta_ge_3.

Definition double_round_plus_beta_ge_3_hyp fexp1 fexp2 :=
  (forall ex ey, (fexp1 (ex + 1) <= ey)%Z -> (fexp2 ex <= fexp1 ey)%Z)
  /\ (forall ex ey, (fexp1 (ex - 1) + 1 <= ey)%Z -> (fexp2 ex <= fexp1 ey)%Z)
  /\ (forall ex ey, (fexp1 ex <= ey)%Z -> (fexp2 ex <= fexp1 ey)%Z)
  /\ (forall ex ey, (ex - 1 <= ey)%Z -> (fexp2 ex <= fexp1 ey)%Z).

(* fexp1 (ln_beta x) <= ln_beta y :
 * addition is exact in the largest precision (fexp2). *)
Lemma double_round_plus_beta_ge_3_aux0 :
  forall (fexp1 fexp2 : Z -> Z), Valid_exp fexp1 ->
  double_round_plus_beta_ge_3_hyp fexp1 fexp2 ->
  forall x y,
  (0 < y)%R -> (y <= x)%R ->
  (fexp1 (ln_beta x) <= ln_beta y)%Z ->
  generic_format beta fexp1 x -> generic_format beta fexp1 y ->
  generic_format beta fexp2 (x + y).
Proof.
(* Goal: forall (fexp1 fexp2 : forall _ : Z, Z) (_ : Valid_exp fexp1) (_ : double_round_plus_beta_ge_3_hyp fexp1 fexp2) (x y : R) (_ : Rlt (IZR Z0) y) (_ : Rle y x) (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta y (Fcore_Raux.ln_beta beta y))) (_ : generic_format beta fexp1 x) (_ : generic_format beta fexp1 y), generic_format beta fexp2 (Rplus x y) *)
intros fexp1 fexp2 Vfexp1 Hexp x y Py Hyx Hln Fx Fy.
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rminus x y) *)
assert (Px := Rlt_le_trans 0 y x Py Hyx).
(* Goal: generic_format beta fexp2 (Rplus x y) *)
assert (Nny : (0 <= y)%R); [now apply Rlt_le|].
(* Goal: generic_format beta fexp2 (Rplus x y) *)
destruct Hexp as (_,(Hexp2,(Hexp3,Hexp4))).
(* Goal: generic_format beta fexp2 (Rplus x y) *)
destruct (Z.le_gt_cases (ln_beta y) (fexp1 (ln_beta x))) as [Hle|Hgt].
- (* ln_beta y <= fexp1 (ln_beta x) *)
  assert (Lxy : ln_beta (x + y) = ln_beta x :> Z);
  [now apply (ln_beta_plus_separated fexp1)|].
  apply (double_round_plus_aux0_aux fexp1);
(* Goal: Z.le (fexp1 (ln_beta_val beta (Rplus x y) (Fcore_Raux.ln_beta beta (Rplus x y)))) (ln_beta_val beta (Rplus x y) (Fcore_Raux.ln_beta beta (Rplus x y))) *)
    [| |assumption|assumption]; rewrite Lxy.
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  + now apply Hexp4; omega.
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  + now apply Hexp3; omega.
- (* fexp1 (ln_beta x) < ln_beta y *)
(* Goal: generic_format beta fexp2 (Rplus x y) *)
  apply (double_round_plus_aux0_aux fexp1); [| |assumption|assumption].
(* Goal: Z.le (fexp2 (ln_beta_val beta (Rplus x y) (Fcore_Raux.ln_beta beta (Rplus x y)))) (fexp1 (ln_beta_val beta y (Fcore_Raux.ln_beta beta y))) *)
  destruct (ln_beta_plus_disj x y Py Hyx) as [Lxy|Lxy]; rewrite Lxy.
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  + now apply Hexp4; omega.
  + apply Hexp2; apply (ln_beta_le beta y x Py) in Hyx.
    replace (_ - _)%Z with (ln_beta x : Z) by ring.
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
    omega.
  + destruct (ln_beta_plus_disj x y Py Hyx) as [Lxy|Lxy]; rewrite Lxy.
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
    * now apply Hexp3; omega.
    * apply Hexp2.
      replace (_ - _)%Z with (ln_beta x : Z) by ring.
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
      omega.
Qed.

(* ln_beta y <= fexp1 (ln_beta x) - 1 : double_round_lt_mid applies. *)
Lemma double_round_plus_beta_ge_3_aux1 :
  (3 <= beta)%Z ->
  forall (fexp1 fexp2 : Z -> Z),
  Valid_exp fexp1 -> Valid_exp fexp2 ->
  forall (choice1 choice2 : Z -> bool),
  double_round_plus_beta_ge_3_hyp fexp1 fexp2 ->
  forall x y,
  0 < x -> 0 < y ->
  (ln_beta y <= fexp1 (ln_beta x) - 1)%Z ->
  generic_format beta fexp1 x ->
  double_round_eq fexp1 fexp2 choice1 choice2 (x + y).
Proof.
(* Goal: forall (_ : Z.le (Zpos (xI xH)) (radix_val beta)) (fexp1 fexp2 : forall _ : Z, Z) (_ : Valid_exp fexp1) (_ : Valid_exp fexp2) (choice1 choice2 : forall _ : Z, bool) (_ : double_round_plus_beta_ge_3_hyp fexp1 fexp2) (x y : R) (_ : Rlt (IZR Z0) x) (_ : Rlt (IZR Z0) y) (_ : Z.le (ln_beta_val beta y (Fcore_Raux.ln_beta beta y)) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Zpos xH))) (_ : generic_format beta fexp1 x), double_round_eq fexp1 fexp2 choice1 choice2 (Rplus x y) *)
intros Hbeta fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x y Px Py Hly Fx.
assert (Lxy : ln_beta (x + y) = ln_beta x :> Z);
  [now apply (ln_beta_plus_separated fexp1); [|apply Rlt_le| |omega]|].
(* Goal: forall _ : not (@eq R x R0), Z.le (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) *)
(* Goal: generic_format beta fexp1 x *)
destruct Hexp as (_,(_,(_,Hexp4))).
assert (Hf2 : (fexp2 (ln_beta x) <= fexp1 (ln_beta x))%Z);
  [now apply Hexp4; omega|].
assert (Bpow3 : bpow (- 1) <= / 3).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ unfold Fcore_Raux.bpow, Z.pow_pos; simpl.
(* Goal: @eq R (Rplus (Rmult (Z2R (Zfloor (scaled_mantissa beta fexp2 rd))) (Fcore_Raux.bpow beta (canonic_exp beta fexp2 x))) (Rmult (Rmult (Z2R n) (Rinv (Z2R (Z.mul (radix_val beta) (Zpos xH))))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) x *)
  rewrite Zmult_1_r.
(* Goal: Rle (Rinv (Z2R (radix_val beta))) (Rinv (IZR (Zpos (xO xH)))) *)
  apply Rinv_le; [lra|].
  now change 3 with (Z2R 3); apply Z2R_le. }
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
assert (P1 : (0 < 1)%Z) by omega.
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
unfold double_round_eq.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rplus x y))) (round beta fexp1 (Znearest choice1) (Rplus x y)) *)
apply double_round_lt_mid.
(* Goal: Valid_exp fexp1 *)
- exact Vfexp1.
- exact Vfexp2.
- lra.
- now rewrite Lxy.
- rewrite Lxy.
(* Goal: Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) *)
  assert (fexp1 (ln_beta x) < ln_beta x)%Z; [|omega].
(* Goal: Z.lt (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) *)
  now apply ln_beta_generic_gt; [|apply Rgt_not_eq|].
- unfold midp.
  apply (Rplus_lt_reg_r (- round beta fexp1 Zfloor (x + y))).
  apply (Rlt_le_trans _ _ _ (proj2 (double_round_plus_aux1_aux 1 P1 fexp1 x y Px
                                                               Py Hly Lxy Fx))).
(* Goal: Rlt (Rplus (Rminus (round beta fexp1 Zceil (Rminus x y)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y)))) (Rminus (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y))) (Rminus x y))) (Rplus (Rminus x y) (Rminus (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y))) (Rminus x y))) *)
  ring_simplify.
(* Goal: Rle (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Zpos xH))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (ulp beta fexp1 (Rplus x y)) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) *)
  rewrite ulp_neq_0;[idtac|now apply Rgt_not_eq, Rplus_lt_0_compat].
(* Goal: Z.le (fexp1 (ln_beta_val beta (Rplus x y) (Fcore_Raux.ln_beta beta (Rplus x y)))) (ln_beta_val beta (Rplus x y) (Fcore_Raux.ln_beta beta (Rplus x y))) *)
  unfold canonic_exp; rewrite Lxy.
  apply (Rmult_le_reg_r (bpow (- fexp1 (ln_beta x))));
    [now apply bpow_gt_0|].
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
  bpow_simplify.
(* Goal: forall _ : Rlt (Rplus (Rplus x' (Rmult (Rinv (IZR (Zpos (xO xH)))) u1)) (Rmult (Rinv (IZR (Zpos (xO xH)))) u2)) x, Rlt (Rplus (Rminus (Rplus x' u1) (Rmult (Rinv (IZR (Zpos (xO xH)))) u1)) (Rmult (Rinv (IZR (Zpos (xO xH)))) u2)) x *)
  apply (Rle_trans _ _ _ Bpow3); lra.
- rewrite ulp_neq_0;[idtac|now apply Rgt_not_eq, Rplus_lt_0_compat].
(* Goal: Z.le (fexp1 (ln_beta_val beta (Rplus x y) (Fcore_Raux.ln_beta beta (Rplus x y)))) (ln_beta_val beta (Rplus x y) (Fcore_Raux.ln_beta beta (Rplus x y))) *)
  unfold round, F2R, scaled_mantissa, canonic_exp; simpl; rewrite Lxy.
(* Goal: forall _ : Z.le (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH)), Rlt (Rplus (midp' fexp1 (Rminus x y)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 (Rminus x y)))) (Rminus x y) *)
  intro Hf2'.
(* Goal: forall _ : @eq R x (midp fexp1 x), @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)) (round beta fexp1 (Znearest choice1) x) *)
  unfold midp.
  apply (Rplus_lt_reg_r (- round beta fexp1 Zfloor (x + y))); ring_simplify.
  rewrite <- Rmult_minus_distr_l.
  apply (Rlt_le_trans _ _ _ (proj2 (double_round_plus_aux1_aux 1 P1 fexp1 x y Px
                                                               Py Hly Lxy Fx))).
(* Goal: Rle (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Zpos xH))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (ulp beta fexp1 (Rplus x y)) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) *)
  rewrite ulp_neq_0;[idtac|now apply Rgt_not_eq, Rplus_lt_0_compat].
(* Goal: Z.le (fexp1 (ln_beta_val beta (Rplus x y) (Fcore_Raux.ln_beta beta (Rplus x y)))) (ln_beta_val beta (Rplus x y) (Fcore_Raux.ln_beta beta (Rplus x y))) *)
  unfold canonic_exp; rewrite Lxy.
  apply (Rmult_le_reg_r (bpow (- fexp1 (ln_beta x))));
    [now apply bpow_gt_0|].
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Zpos xH))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Rmult (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) *)
  rewrite (Rmult_assoc (/ 2)).
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rmult (Rminus (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))))) *)
  rewrite Rmult_minus_distr_r.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
  bpow_simplify.
(* Goal: Rle (Fcore_Raux.bpow beta (Z.opp (Zpos xH))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (IZR (Zpos xH)) (Fcore_Raux.bpow beta (Z.sub (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) *)
  apply (Rle_trans _ _ _ Bpow3).
  apply Rle_trans with (/ 2 * (2 / 3)); [lra|].
(* Goal: Rle (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rdiv (IZR (Zpos (xO xH))) (IZR (Zpos (xI xH))))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (IZR (Zpos xH)) (Fcore_Raux.bpow beta (Z.sub (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))))) *)
  apply Rmult_le_compat_l; [lra|].
  apply (Rplus_le_reg_r (- 1)); ring_simplify.
  replace (_ - _) with (- (/ 3)) by lra.
(* Goal: Rle (Ropp (Rinv (IZR (Zpos (xI xH))))) (Ropp (Fcore_Raux.bpow beta (Z.sub (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) *)
  apply Ropp_le_contravar.
  now apply Rle_trans with (bpow (- 1)); [apply bpow_le; omega|].
Qed.

(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
(* double_round_plus_beta_ge_3_aux{0,1} together *)
Lemma double_round_plus_beta_ge_3_aux2 :
  (3 <= beta)%Z ->
  forall (fexp1 fexp2 : Z -> Z),
  Valid_exp fexp1 -> Valid_exp fexp2 ->
  forall (choice1 choice2 : Z -> bool),
  double_round_plus_beta_ge_3_hyp fexp1 fexp2 ->
  forall x y,
  0 < y -> y <= x ->
  generic_format beta fexp1 x ->
  generic_format beta fexp1 y ->
  double_round_eq fexp1 fexp2 choice1 choice2 (x + y).
Proof.
(* Goal: forall (_ : Z.le (Zpos (xI xH)) (radix_val beta)) (fexp1 fexp2 : forall _ : Z, Z) (_ : Valid_exp fexp1) (_ : Valid_exp fexp2) (choice1 choice2 : forall _ : Z, bool) (_ : double_round_plus_beta_ge_3_hyp fexp1 fexp2) (x y : R) (_ : Rlt (IZR Z0) y) (_ : Rle y x) (_ : generic_format beta fexp1 x) (_ : generic_format beta fexp1 y), double_round_eq fexp1 fexp2 choice1 choice2 (Rminus x y) *)
intros Hbeta fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x y Py Hyx Fx Fy.
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rminus x y) *)
assert (Px := Rlt_le_trans 0 y x Py Hyx).
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
unfold double_round_eq.
destruct (Zle_or_lt (ln_beta y) (fexp1 (ln_beta x) - 1)) as [Hly|Hly].
- (* ln_beta y <= fexp1 (ln_beta x) - 1 *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rplus x y))) (round beta fexp1 (Znearest choice1) (Rplus x y)) *)
  now apply double_round_plus_beta_ge_3_aux1.
- (* fexp1 (ln_beta x) - 1 < ln_beta y *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)) (round beta fexp1 (Znearest choice1) x) *)
  rewrite (round_generic beta fexp2).
  + reflexivity.
  + now apply valid_rnd_N.
  + assert (Hf1 : (fexp1 (ln_beta x) <= ln_beta y)%Z); [omega|].
(* Goal: generic_format beta fexp2 (Rplus x y) *)
    now apply (double_round_plus_beta_ge_3_aux0 fexp1).
Qed.

Lemma double_round_plus_beta_ge_3_aux :
  (3 <= beta)%Z ->
  forall (fexp1 fexp2 : Z -> Z),
  Valid_exp fexp1 -> Valid_exp fexp2 ->
  forall (choice1 choice2 : Z -> bool),
  double_round_plus_beta_ge_3_hyp fexp1 fexp2 ->
  forall x y,
  0 <= x -> 0 <= y ->
  generic_format beta fexp1 x ->
  generic_format beta fexp1 y ->
  double_round_eq fexp1 fexp2 choice1 choice2 (x + y).
Proof.
(* Goal: forall (_ : Z.le (Zpos (xI xH)) (radix_val beta)) (fexp1 fexp2 : forall _ : Z, Z) (_ : Valid_exp fexp1) (_ : Valid_exp fexp2) (choice1 choice2 : forall _ : Z, bool) (_ : double_round_plus_beta_ge_3_hyp fexp1 fexp2) (x y : R) (_ : Rle (IZR Z0) x) (_ : Rle (IZR Z0) y) (_ : generic_format beta fexp1 x) (_ : generic_format beta fexp1 y), double_round_eq fexp1 fexp2 choice1 choice2 (Rminus x y) *)
intros Hbeta fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x y Nnx Nny Fx Fy.
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
unfold double_round_eq.
(* Goal: @eq R (sqrt x) (IZR Z0) *)
destruct (Req_dec x 0) as [Zx|Nzx].
- (* x = 0 *)
(* Goal: forall _ : not (@eq R x R0), Z.le (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) *)
(* Goal: generic_format beta fexp1 x *)
  destruct Hexp as (_,(_,(_,Hexp4))).
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rplus x y))) (round beta fexp1 (Znearest choice1) (Rplus x y)) *)
  rewrite Zx; rewrite Rplus_0_l.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)) (round beta fexp1 (Znearest choice1) x) *)
  rewrite (round_generic beta fexp2).
  + reflexivity.
  + now apply valid_rnd_N.
  + apply (generic_inclusion_ln_beta beta fexp1).
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
    now intros _; apply Hexp4; omega.
(* Goal: generic_format beta fexp1 y *)
    exact Fy.
- (* x <> 0 *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rminus x y))) (round beta fexp1 (Znearest choice1) (Rminus x y)) *)
  destruct (Req_dec y 0) as [Zy|Nzy].
  + (* y = 0 *)
(* Goal: forall _ : not (@eq R x R0), Z.le (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) *)
(* Goal: generic_format beta fexp1 x *)
    destruct Hexp as (_,(_,(_,Hexp4))).
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rplus x y))) (round beta fexp1 (Znearest choice1) (Rplus x y)) *)
    rewrite Zy; rewrite Rplus_0_r.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)) (round beta fexp1 (Znearest choice1) x) *)
    rewrite (round_generic beta fexp2).
    * reflexivity.
    * now apply valid_rnd_N.
    * apply (generic_inclusion_ln_beta beta fexp1).
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
      now intros _; apply Hexp4; omega.
(* Goal: generic_format beta fexp1 x *)
      exact Fx.
  + (* y <> 0 *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rminus x y))) (round beta fexp1 (Znearest choice1) (Rminus x y)) *)
    assert (Px : 0 < x); [lra|].
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rminus x y))) (round beta fexp1 (Znearest choice1) (Rminus x y)) *)
    assert (Py : 0 < y); [lra|].
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rminus x y))) (round beta fexp1 (Znearest choice1) (Rminus x y)) *)
    destruct (Rlt_or_le x y) as [H|H].
    * (* x < y *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rminus x y))) (round beta fexp1 (Znearest choice1) (Rminus x y)) *)
      apply Rlt_le in H.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rplus x y))) (round beta fexp1 (Znearest choice1) (Rplus x y)) *)
      rewrite Rplus_comm.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rplus x y))) (round beta fexp1 (Znearest choice1) (Rplus x y)) *)
      now apply double_round_plus_beta_ge_3_aux2.
    * now apply double_round_plus_beta_ge_3_aux2.
Qed.

(* fexp1 (ln_beta x) <= ln_beta y :
 * substraction is exact in the largest precision (fexp2). *)
Lemma double_round_minus_beta_ge_3_aux0 :
  forall (fexp1 fexp2 : Z -> Z),
  double_round_plus_beta_ge_3_hyp fexp1 fexp2 ->
  forall x y,
  0 < y -> y < x ->
  (fexp1 (ln_beta x) <= ln_beta y)%Z ->
  generic_format beta fexp1 x -> generic_format beta fexp1 y ->
  generic_format beta fexp2 (x - y).
Proof.
(* Goal: forall (fexp1 fexp2 : forall _ : Z, Z) (_ : double_round_plus_beta_ge_3_hyp fexp1 fexp2) (x y : R) (_ : Rlt (IZR Z0) y) (_ : Rlt y x) (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta y (Fcore_Raux.ln_beta beta y))) (_ : generic_format beta fexp1 x) (_ : generic_format beta fexp1 y), generic_format beta fexp2 (Rminus x y) *)
intros fexp1 fexp2 Hexp x y Py Hyx Hln Fx Fy.
(* Goal: generic_format beta fexp2 (Rminus x y) *)
assert (Px := Rlt_trans 0 y x Py Hyx).
(* Goal: generic_format beta fexp2 (Rminus x y) *)
destruct Hexp as (Hexp1,(_,(Hexp3,Hexp4))).
assert (Lyx : (ln_beta y <= ln_beta x)%Z);
  [now apply ln_beta_le; [|apply Rlt_le]|].
destruct (Z.lt_ge_cases (ln_beta x - 2) (ln_beta y)) as [Hlt|Hge].
- (* ln_beta x - 2 < ln_beta y *)
  assert (Hor : (ln_beta y = ln_beta x :> Z)
                \/ (ln_beta y = ln_beta x - 1 :> Z)%Z); [omega|].
(* Goal: generic_format beta fexp2 (Rminus x y) *)
  destruct Hor as [Heq|Heqm1].
  + (* ln_beta y = ln_beta x *)
(* Goal: generic_format beta fexp2 (Rminus x y) *)
    apply (double_round_minus_aux0_aux fexp1); [| |exact Fx|exact Fy].
    * apply Hexp4.
      apply Zle_trans with (ln_beta (x - y)); [omega|].
(* Goal: Z.le (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) *)
      now apply ln_beta_minus.
    * rewrite Heq.
(* Goal: Z.le (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) *)
      apply Hexp4.
      apply Zle_trans with (ln_beta (x - y)); [omega|].
(* Goal: Z.le (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) *)
      now apply ln_beta_minus.
  + (* ln_beta y = ln_beta x - 1 *)
(* Goal: generic_format beta fexp2 (Rminus x y) *)
    apply (double_round_minus_aux0_aux fexp1); [| |exact Fx|exact Fy].
    * apply Hexp4.
      apply Zle_trans with (ln_beta (x - y)); [omega|].
(* Goal: Z.le (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) *)
      now apply ln_beta_minus.
    * rewrite Heqm1.
(* Goal: Z.le (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) *)
      apply Hexp4.
(* Goal: Z.le (Z.sub (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))) (Zpos xH)) (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH)) *)
      apply Zplus_le_compat_r.
(* Goal: Z.le (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) *)
      now apply ln_beta_minus.
- (* ln_beta y <= ln_beta x - 2 *)
(* Goal: generic_format beta fexp2 (Rminus x y) *)
  destruct (ln_beta_minus_disj x y Px Py Hge) as [Lxmy|Lxmy].
  + (* ln_beta (x - y) = ln_beta x *)
(* Goal: generic_format beta fexp2 (Rminus x y) *)
    apply (double_round_minus_aux0_aux fexp1); [| |exact Fx|exact Fy].
    * apply Hexp4.
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
      omega.
    * now rewrite Lxmy; apply Hexp3.
  + (* ln_beta (x - y) = ln_beta x - 1 *)
    apply (double_round_minus_aux0_aux fexp1); [| |exact Fx|exact Fy];
    rewrite Lxmy.
    * apply Hexp1.
      replace (_ + _)%Z with (ln_beta x : Z); [|ring].
(* Goal: Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) *)
      now apply Zle_trans with (ln_beta y).
    * apply Hexp1.
      now replace (_ + _)%Z with (ln_beta x : Z); [|ring].
Qed.

(* ln_beta y <= fexp1 (ln_beta x) - 1,
 * fexp1 (ln_beta (x - y)) <= ln_beta y :
 * substraction is exact in the largest precision (fexp2). *)
Lemma double_round_minus_beta_ge_3_aux1 :
  forall (fexp1 fexp2 : Z -> Z),
  Valid_exp fexp1 -> Valid_exp fexp2 ->
  double_round_plus_beta_ge_3_hyp fexp1 fexp2 ->
  forall x y,
  0 < y -> y < x ->
  (ln_beta y <= fexp1 (ln_beta x) - 1)%Z ->
  (fexp1 (ln_beta (x - y)) <= ln_beta y)%Z ->
  generic_format beta fexp1 x -> generic_format beta fexp1 y ->
  generic_format beta fexp2 (x - y).
Proof.
intros fexp1 fexp2 Vfexp1 Vfexp2  Hexp x y Py Hyx Hln Hln' Fx Fy.
(* Goal: generic_format beta fexp2 (Rminus x y) *)
assert (Px := Rlt_trans 0 y x Py Hyx).
(* Goal: generic_format beta fexp2 (Rminus x y) *)
destruct Hexp as (Hexp1,(Hexp2,(Hexp3,Hexp4))).
assert (Lyx : (ln_beta y <= ln_beta x)%Z);
  [now apply ln_beta_le; [|apply Rlt_le]|].
assert (Hfx : (fexp1 (ln_beta x) < ln_beta x)%Z);
  [now apply ln_beta_generic_gt; [|apply Rgt_not_eq|]|].
assert (Hfy : (fexp1 (ln_beta y) < ln_beta y)%Z);
  [now apply ln_beta_generic_gt; [|apply Rgt_not_eq|]|].
(* Goal: generic_format beta fexp2 (Rminus x y) *)
apply (double_round_minus_aux0_aux fexp1); [| |exact Fx|exact Fy].
- apply Zle_trans with (fexp1 (ln_beta (x - y))).
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  + apply Hexp4; omega.
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  + omega.
- now apply Hexp3.
Qed.

(* ln_beta y <= fexp1 (ln_beta x) - 1 :
 * ln_beta y <= fexp1 (ln_beta (x - y)) - 1 :
 * double_round_gt_mid applies. *)
Lemma double_round_minus_beta_ge_3_aux2 :
  (3 <= beta)%Z ->
  forall (fexp1 fexp2 : Z -> Z),
  Valid_exp fexp1 -> Valid_exp fexp2 ->
  forall (choice1 choice2 : Z -> bool),
  double_round_plus_beta_ge_3_hyp fexp1 fexp2 ->
  forall x y,
  0 < y -> y < x ->
  (ln_beta y <= fexp1 (ln_beta x) - 1)%Z ->
  (ln_beta y <= fexp1 (ln_beta (x - y)) - 1)%Z ->
  generic_format beta fexp1 x ->
  generic_format beta fexp1 y ->
  double_round_eq fexp1 fexp2 choice1 choice2 (x - y).
Proof.
(* Goal: forall (_ : Z.le (Zpos (xI xH)) (radix_val beta)) (fexp1 fexp2 : forall _ : Z, Z) (_ : Valid_exp fexp1) (_ : Valid_exp fexp2) (choice1 choice2 : forall _ : Z, bool) (_ : double_round_plus_beta_ge_3_hyp fexp1 fexp2) (x y : R) (_ : Rlt (IZR Z0) y) (_ : Rlt y x) (_ : Z.le (ln_beta_val beta y (Fcore_Raux.ln_beta beta y)) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Zpos xH))) (_ : Z.le (ln_beta_val beta y (Fcore_Raux.ln_beta beta y)) (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (_ : generic_format beta fexp1 x) (_ : generic_format beta fexp1 y), double_round_eq fexp1 fexp2 choice1 choice2 (Rminus x y) *)
intros Hbeta fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x y Py Hxy Hly Hly' Fx Fy.
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rminus x y) *)
assert (Px := Rlt_trans 0 y x Py Hxy).
(* Goal: forall _ : not (@eq R x R0), Z.le (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) *)
(* Goal: generic_format beta fexp1 x *)
destruct Hexp as (_,(_,(_,Hexp4))).
assert (Hf2 : (fexp2 (ln_beta x) <= fexp1 (ln_beta x))%Z);
  [now apply Hexp4; omega|].
assert (Hfx : (fexp1 (ln_beta x) < ln_beta x)%Z);
  [now apply ln_beta_generic_gt; [|apply Rgt_not_eq|]|].
assert (Bpow3 : bpow (- 1) <= / 3).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ unfold Fcore_Raux.bpow, Z.pow_pos; simpl.
(* Goal: @eq R (Rplus (Rmult (Z2R (Zfloor (scaled_mantissa beta fexp2 rd))) (Fcore_Raux.bpow beta (canonic_exp beta fexp2 x))) (Rmult (Rmult (Z2R n) (Rinv (Z2R (Z.mul (radix_val beta) (Zpos xH))))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) x *)
  rewrite Zmult_1_r.
(* Goal: Rle (Rinv (Z2R (radix_val beta))) (Rinv (IZR (Zpos (xO xH)))) *)
  apply Rinv_le; [lra|].
  now change 3 with (Z2R 3); apply Z2R_le. }
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rminus x y) *)
assert (Ly : y < bpow (ln_beta y)).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ apply Rabs_lt_inv.
  apply bpow_ln_beta_gt. }
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
unfold double_round_eq.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rminus x y))) (round beta fexp1 (Znearest choice1) (Rminus x y)) *)
apply double_round_gt_mid.
(* Goal: Valid_exp fexp1 *)
- exact Vfexp1.
- exact Vfexp2.
- lra.
- apply Hexp4; omega.
- assert (fexp1 (ln_beta (x - y)) < ln_beta (x - y))%Z; [|omega].
  apply (valid_exp_large fexp1 (ln_beta x - 1)).
  + apply (valid_exp_large fexp1 (ln_beta y)); [|omega].
(* Goal: Z.lt (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) *)
    now apply ln_beta_generic_gt; [|apply Rgt_not_eq|].
  + now apply ln_beta_minus_lb; [| |omega].
- unfold midp'.
  apply (Rplus_lt_reg_r (/ 2 * ulp beta fexp1 (x - y) - (x - y))).
(* Goal: Rlt (Rplus (Rminus (round beta fexp1 Zceil (Rminus x y)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y)))) (Rminus (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y))) (Rminus x y))) (Rplus (Rminus x y) (Rminus (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y))) (Rminus x y))) *)
  ring_simplify.
  replace (_ + _) with (round beta fexp1 Zceil (x - y) - (x - y)) by ring.
  apply Rlt_le_trans with (bpow (fexp1 (ln_beta (x - y)) - 1)).
  + apply Rle_lt_trans with y;
    [now apply double_round_minus_aux2_aux|].
(* Goal: Rlt y (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (ulp beta fexp1 (Rminus x y)) (ulp beta fexp2 (Rminus x y)))) *)
    apply (Rlt_le_trans _ _ _ Ly).
(* Goal: Rle (Fcore_Raux.bpow beta (ln_beta_val beta y (Fcore_Raux.ln_beta beta y))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) *)
    now apply bpow_le.
  + rewrite ulp_neq_0;[idtac|now apply Rgt_not_eq, Rgt_minus].
(* Goal: Rle (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (Fcore_Raux.bpow beta (canonic_exp beta fexp1 (Rminus x y))) (Fcore_Raux.bpow beta (canonic_exp beta fexp2 (Rminus x y))))) *)
    unfold canonic_exp.
(* Goal: Rlt x (Fcore_Raux.bpow beta (Z.add (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))))) *)
    unfold Zminus at 1; rewrite bpow_plus.
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))) (Fcore_Raux.bpow beta (Z.opp (Zpos xH)))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))) *)
    rewrite Rmult_comm.
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (Z.opp (Zpos xH))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))) *)
    apply Rmult_le_compat_r; [now apply bpow_ge_0|].
(* Goal: Rle (Fcore_Raux.bpow beta (Zneg xH)) (Rinv (IZR (Zpos (xI xH)))) *)
    unfold Fcore_Raux.bpow, Z.pow_pos; simpl.
(* Goal: Rle (Rinv (Z2R (radix_val beta))) (Rinv (IZR (Zpos (xO xH)))) *)
    rewrite Zmult_1_r; apply Rinv_le; [lra|].
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
    now change 2 with (Z2R 2); apply Z2R_le; omega.
- intro Hf2'.
(* Goal: Rlt (Rplus (midp' fexp1 (Rminus x y)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 (Rminus x y)))) (Rminus x y) *)
  unfold midp'.
  apply (Rplus_lt_reg_r (/ 2 * (ulp beta fexp1 (x - y)
                                - ulp beta fexp2 (x - y)) - (x - y))).
  ring_simplify; rewrite <- Rmult_minus_distr_l.
  replace (_ + _) with (round beta fexp1 Zceil (x - y) - (x - y)) by ring.
  apply Rle_lt_trans with y;
    [now apply double_round_minus_aux2_aux|].
(* Goal: Rlt y (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (ulp beta fexp1 (Rminus x y)) (ulp beta fexp2 (Rminus x y)))) *)
  apply (Rlt_le_trans _ _ _ Ly).
  apply Rle_trans with (bpow (fexp1 (ln_beta (x - y)) - 1));
    [now apply bpow_le|].
(* Goal: Rle (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (ulp beta fexp1 (Rminus x y)) (ulp beta fexp2 (Rminus x y)))) *)
  rewrite 2!ulp_neq_0; try now apply Rgt_not_eq, Rgt_minus.
(* Goal: Rle (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (Fcore_Raux.bpow beta (canonic_exp beta fexp1 (Rminus x y))) (Fcore_Raux.bpow beta (canonic_exp beta fexp2 (Rminus x y))))) *)
  unfold canonic_exp.
  apply (Rmult_le_reg_r (bpow (- fexp1 (ln_beta (x - y)))));
    [now apply bpow_gt_0|].
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Rmult (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) *)
  rewrite Rmult_assoc.
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rmult (Rminus (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))))) *)
  rewrite Rmult_minus_distr_r.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
  bpow_simplify.
(* Goal: Rle (Fcore_Raux.bpow beta (Z.opp (Zpos xH))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (IZR (Zpos xH)) (Fcore_Raux.bpow beta (Z.sub (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))))) *)
  apply Rle_trans with (/ 3).
  + unfold Fcore_Raux.bpow, Z.pow_pos; simpl.
(* Goal: Rle (Rinv (Z2R (radix_val beta))) (Rinv (IZR (Zpos (xO xH)))) *)
    rewrite Zmult_1_r; apply Rinv_le; [lra|].
(* Goal: Rle (Z2R (Zceil (Rmult (Rminus x y) (Fcore_Raux.bpow beta (Z.opp (fexp (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH)))))))) (Z2R (Z.pow (radix_val beta) (Z.sub (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (fexp (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH)))) (Zpos xH)))) *)
    now change 3 with (Z2R 3); apply Z2R_le.
  + replace (/ 3) with (/ 2 * (2 / 3)) by field.
(* Goal: Rle (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rdiv (IZR (Zpos (xO xH))) (IZR (Zpos (xI xH))))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (IZR (Zpos xH)) (Fcore_Raux.bpow beta (Z.sub (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))))) *)
    apply Rmult_le_compat_l; [lra|].
    apply (Rplus_le_reg_r (- 1)); ring_simplify.
    replace (_ - _) with (- / 3) by field.
(* Goal: Rle (Ropp (Rinv (IZR (Zpos (xI xH))))) (Ropp (Fcore_Raux.bpow beta (Z.sub (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) *)
    apply Ropp_le_contravar.
    apply Rle_trans with (bpow (- 1)).
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
    * apply bpow_le; omega.
    * unfold Fcore_Raux.bpow, Z.pow_pos; simpl.
(* Goal: Rle (Rinv (Z2R (radix_val beta))) (Rinv (IZR (Zpos (xO xH)))) *)
      rewrite Zmult_1_r; apply Rinv_le; [lra|].
(* Goal: Rle (Z2R (Zceil (Rmult (Rminus x y) (Fcore_Raux.bpow beta (Z.opp (fexp (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH)))))))) (Z2R (Z.pow (radix_val beta) (Z.sub (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (fexp (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH)))) (Zpos xH)))) *)
      now change 3 with (Z2R 3); apply Z2R_le.
Qed.

(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
(* double_round_minus_aux{0,1,2} together *)
Lemma double_round_minus_beta_ge_3_aux3 :
  (3 <= beta)%Z ->
  forall (fexp1 fexp2 : Z -> Z),
  Valid_exp fexp1 -> Valid_exp fexp2 ->
  forall (choice1 choice2 : Z -> bool),
  double_round_plus_beta_ge_3_hyp fexp1 fexp2 ->
  forall x y,
  0 < y -> y <= x ->
  generic_format beta fexp1 x ->
  generic_format beta fexp1 y ->
  double_round_eq fexp1 fexp2 choice1 choice2 (x - y).
Proof.
(* Goal: forall (_ : Z.le (Zpos (xI xH)) (radix_val beta)) (fexp1 fexp2 : forall _ : Z, Z) (_ : Valid_exp fexp1) (_ : Valid_exp fexp2) (choice1 choice2 : forall _ : Z, bool) (_ : double_round_plus_beta_ge_3_hyp fexp1 fexp2) (x y : R) (_ : Rlt (IZR Z0) y) (_ : Rle y x) (_ : generic_format beta fexp1 x) (_ : generic_format beta fexp1 y), double_round_eq fexp1 fexp2 choice1 choice2 (Rminus x y) *)
intros Hbeta fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x y Py Hyx Fx Fy.
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rminus x y) *)
assert (Px := Rlt_le_trans 0 y x Py Hyx).
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
unfold double_round_eq.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rminus x y))) (round beta fexp1 (Znearest choice1) (Rminus x y)) *)
destruct (Req_dec y x) as [Hy|Hy].
- (* y = x *)
  rewrite Hy; replace (x - x) with 0 by ring.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (IZR Z0))) (round beta fexp1 (Znearest choice1) (IZR Z0)) *)
  rewrite round_0.
  + reflexivity.
  + now apply valid_rnd_N.
- (* y < x *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rminus x y))) (round beta fexp1 (Znearest choice1) (Rminus x y)) *)
  assert (Hyx' : y < x); [lra|].
  destruct (Zle_or_lt (ln_beta y) (fexp1 (ln_beta x) - 1)) as [Hly|Hly].
  + (* ln_beta y <= fexp1 (ln_beta x) - 1 *)
    destruct (Zle_or_lt (ln_beta y) (fexp1 (ln_beta (x - y)) - 1))
      as [Hly'|Hly'].
    * (* ln_beta y <= fexp1 (ln_beta (x - y)) - 1 *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rminus x y))) (round beta fexp1 (Znearest choice1) (Rminus x y)) *)
      now apply double_round_minus_beta_ge_3_aux2.
    * (* fexp1 (ln_beta (x - y)) - 1 < ln_beta y *)
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
      { rewrite (round_generic beta fexp2).
        - reflexivity.
        - now apply valid_rnd_N.
        - assert (Hf1 : (fexp1 (ln_beta (x - y)) <= ln_beta y)%Z); [omega|].
          now apply (double_round_minus_beta_ge_3_aux1 fexp1). }
  + rewrite (round_generic beta fexp2).
    * reflexivity.
    * now apply valid_rnd_N.
    * assert (Hf1 : (fexp1 (ln_beta x) <= ln_beta y)%Z); [omega|].
(* Goal: generic_format beta fexp2 (Rminus x y) *)
      now apply (double_round_minus_beta_ge_3_aux0 fexp1).
Qed.

Lemma double_round_minus_beta_ge_3_aux :
  (3 <= beta)%Z ->
  forall (fexp1 fexp2 : Z -> Z),
  Valid_exp fexp1 -> Valid_exp fexp2 ->
  forall (choice1 choice2 : Z -> bool),
  double_round_plus_beta_ge_3_hyp fexp1 fexp2 ->
  forall x y,
  0 <= x -> 0 <= y ->
  generic_format beta fexp1 x ->
  generic_format beta fexp1 y ->
  double_round_eq fexp1 fexp2 choice1 choice2 (x - y).
Proof.
(* Goal: forall (_ : Z.le (Zpos (xI xH)) (radix_val beta)) (fexp1 fexp2 : forall _ : Z, Z) (_ : Valid_exp fexp1) (_ : Valid_exp fexp2) (choice1 choice2 : forall _ : Z, bool) (_ : double_round_plus_beta_ge_3_hyp fexp1 fexp2) (x y : R) (_ : Rle (IZR Z0) x) (_ : Rle (IZR Z0) y) (_ : generic_format beta fexp1 x) (_ : generic_format beta fexp1 y), double_round_eq fexp1 fexp2 choice1 choice2 (Rminus x y) *)
intros Hbeta fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x y Nnx Nny Fx Fy.
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
unfold double_round_eq.
(* Goal: @eq R (sqrt x) (IZR Z0) *)
destruct (Req_dec x 0) as [Zx|Nzx].
- (* x = 0 *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rminus x y))) (round beta fexp1 (Znearest choice1) (Rminus x y)) *)
  rewrite Zx; unfold Rminus; rewrite Rplus_0_l.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Ropp (Rmult x (Rinv (Ropp y)))))) (round beta fexp1 (Znearest choice1) (Ropp (Rmult x (Rinv (Ropp y))))) *)
  do 3 rewrite round_N_opp.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)) (round beta fexp1 (Znearest choice1) x) *)
  rewrite (round_generic beta fexp2).
  * reflexivity.
  * now apply valid_rnd_N.
  * apply (generic_inclusion_ln_beta beta fexp1).
(* Goal: forall _ : not (@eq R x R0), Z.le (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) *)
(* Goal: generic_format beta fexp1 x *)
    destruct Hexp as (_,(_,(_,Hexp4))).
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
    now intros _; apply Hexp4; omega.
(* Goal: generic_format beta fexp1 y *)
    exact Fy.
- (* x <> 0 *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rminus x y))) (round beta fexp1 (Znearest choice1) (Rminus x y)) *)
  destruct (Req_dec y 0) as [Zy|Nzy].
  + (* y = 0 *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rminus x y))) (round beta fexp1 (Znearest choice1) (Rminus x y)) *)
    rewrite Zy; unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)) (round beta fexp1 (Znearest choice1) x) *)
    rewrite (round_generic beta fexp2).
    * reflexivity.
    * now apply valid_rnd_N.
    * apply (generic_inclusion_ln_beta beta fexp1).
(* Goal: forall _ : not (@eq R x R0), Z.le (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) *)
(* Goal: generic_format beta fexp1 x *)
      destruct Hexp as (_,(_,(_,Hexp4))).
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
      now intros _; apply Hexp4; omega.
(* Goal: generic_format beta fexp1 x *)
      exact Fx.
  + (* y <> 0 *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rminus x y))) (round beta fexp1 (Znearest choice1) (Rminus x y)) *)
    assert (Px : 0 < x); [lra|].
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rminus x y))) (round beta fexp1 (Znearest choice1) (Rminus x y)) *)
    assert (Py : 0 < y); [lra|].
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rminus x y))) (round beta fexp1 (Znearest choice1) (Rminus x y)) *)
    destruct (Rlt_or_le x y) as [H|H].
    * (* x < y *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rminus x y))) (round beta fexp1 (Znearest choice1) (Rminus x y)) *)
      apply Rlt_le in H.
      replace (x - y) with (- (y - x)) by ring.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Ropp (Rmult x (Rinv (Ropp y)))))) (round beta fexp1 (Znearest choice1) (Ropp (Rmult x (Rinv (Ropp y))))) *)
      do 3 rewrite round_N_opp.
(* Goal: @eq R (Ropp (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (round beta fexp2 (Znearest (fun t : Z => negb (choice2 (Z.opp (Z.add t (Zpos xH)))))) (Rmult x (Rinv (Ropp y)))))) (Ropp (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (Rmult x (Rinv (Ropp y))))) *)
      apply Ropp_eq_compat.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rminus x y))) (round beta fexp1 (Znearest choice1) (Rminus x y)) *)
      now apply double_round_minus_beta_ge_3_aux3.
    * (* y <= x *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rminus x y))) (round beta fexp1 (Znearest choice1) (Rminus x y)) *)
      now apply double_round_minus_beta_ge_3_aux3.
Qed.

Lemma double_round_plus_beta_ge_3 :
  (3 <= beta)%Z ->
  forall (fexp1 fexp2 : Z -> Z),
  Valid_exp fexp1 -> Valid_exp fexp2 ->
  forall (choice1 choice2 : Z -> bool),
  double_round_plus_beta_ge_3_hyp fexp1 fexp2 ->
  forall x y,
  generic_format beta fexp1 x ->
  generic_format beta fexp1 y ->
  double_round_eq fexp1 fexp2 choice1 choice2 (x + y).
Proof.
(* Goal: forall (_ : Z.le (Zpos (xI xH)) (radix_val beta)) (fexp1 fexp2 : forall _ : Z, Z) (_ : Valid_exp fexp1) (_ : Valid_exp fexp2) (choice1 choice2 : forall _ : Z, bool) (_ : double_round_plus_beta_ge_3_hyp fexp1 fexp2) (x y : R) (_ : generic_format beta fexp1 x) (_ : generic_format beta fexp1 y), double_round_eq fexp1 fexp2 choice1 choice2 (Rminus x y) *)
intros Hbeta fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x y Fx Fy.
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
unfold double_round_eq.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rplus x y))) (round beta fexp1 (Znearest choice1) (Rplus x y)) *)
destruct (Rlt_or_le x 0) as [Sx|Sx]; destruct (Rlt_or_le y 0) as [Sy|Sy].
- (* x < 0, y < 0 *)
  replace (x + y) with (- (- x - y)); [|ring].
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Ropp (Rmult x (Rinv (Ropp y)))))) (round beta fexp1 (Znearest choice1) (Ropp (Rmult x (Rinv (Ropp y))))) *)
  do 3 rewrite round_N_opp.
(* Goal: @eq R (Ropp (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (round beta fexp2 (Znearest (fun t : Z => negb (choice2 (Z.opp (Z.add t (Zpos xH)))))) (Rmult x (Rinv (Ropp y)))))) (Ropp (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (Rmult x (Rinv (Ropp y))))) *)
  apply Ropp_eq_compat.
  assert (Px : 0 <= - x); [lra|].
  assert (Py : 0 <= - y); [lra|].
(* Goal: @eq R (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (round beta fexp2 (Znearest (fun t : Z => negb (choice2 (Z.opp (Z.add t (Zpos xH)))))) (Rdiv (Ropp x) y))) (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (Rdiv (Ropp x) y)) *)
  apply generic_format_opp in Fx.
(* Goal: @eq R (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (round beta fexp2 (Znearest (fun t : Z => negb (choice2 (Z.opp (Z.add t (Zpos xH)))))) (Rmult x (Rinv (Ropp y))))) (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (Rmult x (Rinv (Ropp y)))) *)
  apply generic_format_opp in Fy.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rplus x y))) (round beta fexp1 (Znearest choice1) (Rplus x y)) *)
  now apply double_round_plus_beta_ge_3_aux.
- (* x < 0, 0 <= y *)
  replace (x + y) with (y - (- x)); [|ring].
  assert (Px : 0 <= - x); [lra|].
(* Goal: @eq R (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (round beta fexp2 (Znearest (fun t : Z => negb (choice2 (Z.opp (Z.add t (Zpos xH)))))) (Rdiv (Ropp x) y))) (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (Rdiv (Ropp x) y)) *)
  apply generic_format_opp in Fx.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rminus x (Ropp y)))) (round beta fexp1 (Znearest choice1) (Rminus x (Ropp y))) *)
  now apply double_round_minus_beta_ge_3_aux.
- (* 0 <= x, y < 0 *)
  replace (x + y) with (x - (- y)); [|ring].
  assert (Py : 0 <= - y); [lra|].
(* Goal: @eq R (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (round beta fexp2 (Znearest (fun t : Z => negb (choice2 (Z.opp (Z.add t (Zpos xH)))))) (Rmult x (Rinv (Ropp y))))) (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (Rmult x (Rinv (Ropp y)))) *)
  apply generic_format_opp in Fy.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rminus x (Ropp y)))) (round beta fexp1 (Znearest choice1) (Rminus x (Ropp y))) *)
  now apply double_round_minus_beta_ge_3_aux.
- (* 0 <= x, 0 <= y *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rplus x y))) (round beta fexp1 (Znearest choice1) (Rplus x y)) *)
  now apply double_round_plus_beta_ge_3_aux.
Qed.

Lemma double_round_minus_beta_ge_3 :
  (3 <= beta)%Z ->
  forall (fexp1 fexp2 : Z -> Z),
  Valid_exp fexp1 -> Valid_exp fexp2 ->
  forall (choice1 choice2 : Z -> bool),
  double_round_plus_beta_ge_3_hyp fexp1 fexp2 ->
  forall x y,
  generic_format beta fexp1 x ->
  generic_format beta fexp1 y ->
  double_round_eq fexp1 fexp2 choice1 choice2 (x - y).
Proof.
(* Goal: forall (_ : Z.le (Zpos (xI xH)) (radix_val beta)) (fexp1 fexp2 : forall _ : Z, Z) (_ : Valid_exp fexp1) (_ : Valid_exp fexp2) (choice1 choice2 : forall _ : Z, bool) (_ : double_round_plus_beta_ge_3_hyp fexp1 fexp2) (x y : R) (_ : generic_format beta fexp1 x) (_ : generic_format beta fexp1 y), double_round_eq fexp1 fexp2 choice1 choice2 (Rminus x y) *)
intros Hbeta fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x y Fx Fy.
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rminus x y) *)
unfold Rminus.
(* Goal: @eq R (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (round beta fexp2 (Znearest (fun t : Z => negb (choice2 (Z.opp (Z.add t (Zpos xH)))))) (Rmult x (Rinv (Ropp y))))) (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (Rmult x (Rinv (Ropp y)))) *)
apply generic_format_opp in Fy.
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rplus x (Ropp y)) *)
now apply double_round_plus_beta_ge_3.
Qed.

Section Double_round_plus_beta_ge_3_FLX.

Import Fcore_FLX.

Variable prec : Z.
Variable prec' : Z.

(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
Context { prec_gt_0_ : Prec_gt_0 prec }.
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
Context { prec_gt_0_' : Prec_gt_0 prec' }.

Lemma FLX_double_round_plus_beta_ge_3_hyp :
  (2 * prec <= prec')%Z ->
  double_round_plus_beta_ge_3_hyp (FLX_exp prec) (FLX_exp prec').
Proof.
(* Goal: forall _ : Z.le (Z.mul (Zpos (xO xH)) prec) prec', double_round_div_hyp (FLX_exp prec) (FLX_exp prec') *)
intros Hprec.
(* Goal: double_round_div_hyp (FLX_exp prec) (FLX_exp prec') *)
unfold FLX_exp.
unfold double_round_plus_beta_ge_3_hyp; split; [|split; [|split]];
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
intros ex ey; try omega.
(* Goal: double_round_div_hyp (fun e : Z => if Z.ltb (Z.sub e prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub e prec) (fun e : Z => if Z.ltb (Z.sub e prec') emin' then Z.sub (Z.add emin' prec') (Zpos xH) else Z.sub e prec') *)
unfold Prec_gt_0 in prec_gt_0_.
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
omega.
Qed.

Theorem double_round_plus_beta_ge_3_FLX :
  (3 <= beta)%Z ->
  forall choice1 choice2,
  (2 * prec <= prec')%Z ->
  forall x y,
  FLX_format beta prec x -> FLX_format beta prec y ->
  double_round_eq (FLX_exp prec) (FLX_exp prec') choice1 choice2 (x + y).
Proof.
(* Goal: forall (_ : Z.le (Zpos (xI xH)) (radix_val beta)) (choice1 choice2 : forall _ : Z, bool) (_ : Z.le (Z.mul (Zpos (xO xH)) prec) prec') (x y : R) (_ : FLX_format beta prec x) (_ : FLX_format beta prec y), double_round_eq (FLX_exp prec) (FLX_exp prec') choice1 choice2 (Rminus x y) *)
intros Hbeta choice1 choice2 Hprec x y Fx Fy.
(* Goal: double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec') choice1 choice2 (Rplus x y) *)
apply double_round_plus_beta_ge_3.
- exact Hbeta.
- now apply FLX_exp_valid.
- now apply FLX_exp_valid.
- now apply FLX_double_round_plus_beta_ge_3_hyp.
- now apply generic_format_FLX.
- now apply generic_format_FLX.
Qed.

Theorem double_round_minus_beta_ge_3_FLX :
  (3 <= beta)%Z ->
  forall choice1 choice2,
  (2 * prec <= prec')%Z ->
  forall x y,
  FLX_format beta prec x -> FLX_format beta prec y ->
  double_round_eq (FLX_exp prec) (FLX_exp prec') choice1 choice2 (x - y).
Proof.
(* Goal: forall (_ : Z.le (Zpos (xI xH)) (radix_val beta)) (choice1 choice2 : forall _ : Z, bool) (_ : Z.le (Z.mul (Zpos (xO xH)) prec) prec') (x y : R) (_ : FLX_format beta prec x) (_ : FLX_format beta prec y), double_round_eq (FLX_exp prec) (FLX_exp prec') choice1 choice2 (Rminus x y) *)
intros Hbeta choice1 choice2 Hprec x y Fx Fy.
(* Goal: double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec') choice1 choice2 (Rminus x y) *)
apply double_round_minus_beta_ge_3.
- exact Hbeta.
- now apply FLX_exp_valid.
- now apply FLX_exp_valid.
- now apply FLX_double_round_plus_beta_ge_3_hyp.
- now apply generic_format_FLX.
- now apply generic_format_FLX.
Qed.

End Double_round_plus_beta_ge_3_FLX.

Section Double_round_plus_beta_ge_3_FLT.

Import Fcore_FLX.
Import Fcore_FLT.

Variable emin prec : Z.
Variable emin' prec' : Z.

(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
Context { prec_gt_0_ : Prec_gt_0 prec }.
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
Context { prec_gt_0_' : Prec_gt_0 prec' }.

Lemma FLT_double_round_plus_beta_ge_3_hyp :
  (emin' <= emin)%Z -> (2 * prec <= prec')%Z ->
  double_round_plus_beta_ge_3_hyp (FLT_exp emin prec) (FLT_exp emin' prec').
Proof.
(* Goal: forall (_ : Z.le (Z.add emin' prec') (Z.sub emin (Zpos xH))) (_ : Z.le (Z.mul (Zpos (xO xH)) prec) prec'), double_round_div_hyp (FTZ_exp emin prec) (FTZ_exp emin' prec') *)
intros Hemin Hprec.
(* Goal: double_round_div_hyp (FLT_exp emin prec) (FLT_exp emin' prec') *)
unfold FLT_exp.
(* Goal: double_round_plus_beta_ge_3_hyp (fun e : Z => if Z.ltb (Z.sub e prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub e prec) (fun e : Z => if Z.ltb (Z.sub e prec') emin' then Z.sub (Z.add emin' prec') (Zpos xH) else Z.sub e prec') *)
unfold double_round_plus_beta_ge_3_hyp; split; [|split; [|split]]; intros ex ey.
- generalize (Zmax_spec (ex + 1 - prec) emin).
  generalize (Zmax_spec (ex - prec') emin').
  generalize (Zmax_spec (ey - prec) emin).
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  omega.
- generalize (Zmax_spec (ex - 1 - prec) emin).
  generalize (Zmax_spec (ex - prec') emin').
  generalize (Zmax_spec (ey - prec) emin).
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  omega.
- generalize (Zmax_spec (ex - prec) emin).
  generalize (Zmax_spec (ex - prec') emin').
  generalize (Zmax_spec (ey - prec) emin).
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  omega.
- unfold Prec_gt_0 in prec_gt_0_.
  generalize (Zmax_spec (ex - prec') emin').
  generalize (Zmax_spec (ey - prec) emin).
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  omega.
Qed.

Theorem double_round_plus_beta_ge_3_FLT :
  (3 <= beta)%Z ->
  forall choice1 choice2,
  (emin' <= emin)%Z -> (2 * prec <= prec')%Z ->
  forall x y,
  FLT_format beta emin prec x -> FLT_format beta emin prec y ->
  double_round_eq (FLT_exp emin prec) (FLT_exp emin' prec')
                  choice1 choice2 (x + y).
Proof.
(* Goal: forall (_ : Z.le (Zpos (xI xH)) (radix_val beta)) (choice1 choice2 : forall _ : Z, bool) (_ : Z.le (Z.add emin' prec') (Z.add emin (Zpos xH))) (_ : Z.le (Z.mul (Zpos (xO xH)) prec) prec') (x y : R) (_ : FTZ_format beta emin prec x) (_ : FTZ_format beta emin prec y), double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec') choice1 choice2 (Rminus x y) *)
intros Hbeta choice1 choice2 Hemin Hprec x y Fx Fy.
(* Goal: double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec') choice1 choice2 (Rplus x y) *)
apply double_round_plus_beta_ge_3.
- exact Hbeta.
- now apply FLT_exp_valid.
- now apply FLT_exp_valid.
- now apply FLT_double_round_plus_beta_ge_3_hyp.
- now apply generic_format_FLT.
- now apply generic_format_FLT.
Qed.

Theorem double_round_minus_beta_ge_3_FLT :
  (3 <= beta)%Z ->
  forall choice1 choice2,
  (emin' <= emin)%Z -> (2 * prec <= prec')%Z ->
  forall x y,
  FLT_format beta emin prec x -> FLT_format beta emin prec y ->
  double_round_eq (FLT_exp emin prec) (FLT_exp emin' prec')
                  choice1 choice2 (x - y).
Proof.
(* Goal: forall (_ : Z.le (Zpos (xI xH)) (radix_val beta)) (choice1 choice2 : forall _ : Z, bool) (_ : Z.le (Z.add emin' prec') (Z.add emin (Zpos xH))) (_ : Z.le (Z.mul (Zpos (xO xH)) prec) prec') (x y : R) (_ : FTZ_format beta emin prec x) (_ : FTZ_format beta emin prec y), double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec') choice1 choice2 (Rminus x y) *)
intros Hbeta choice1 choice2 Hemin Hprec x y Fx Fy.
(* Goal: double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec') choice1 choice2 (Rminus x y) *)
apply double_round_minus_beta_ge_3.
- exact Hbeta.
- now apply FLT_exp_valid.
- now apply FLT_exp_valid.
- now apply FLT_double_round_plus_beta_ge_3_hyp.
- now apply generic_format_FLT.
- now apply generic_format_FLT.
Qed.

End Double_round_plus_beta_ge_3_FLT.

Section Double_round_plus_beta_ge_3_FTZ.

Import Fcore_FLX.
Import Fcore_FTZ.

Variable emin prec : Z.
Variable emin' prec' : Z.

(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
Context { prec_gt_0_ : Prec_gt_0 prec }.
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
Context { prec_gt_0_' : Prec_gt_0 prec' }.

Lemma FTZ_double_round_plus_beta_ge_3_hyp :
  (emin' + prec' <= emin + 1)%Z -> (2 * prec <= prec')%Z ->
  double_round_plus_beta_ge_3_hyp (FTZ_exp emin prec) (FTZ_exp emin' prec').
Proof.
(* Goal: forall (_ : Z.le (Z.add emin' prec') (Z.sub emin (Zpos xH))) (_ : Z.le (Z.mul (Zpos (xO xH)) prec) prec'), double_round_div_hyp (FTZ_exp emin prec) (FTZ_exp emin' prec') *)
intros Hemin Hprec.
(* Goal: double_round_div_hyp (FTZ_exp emin prec) (FTZ_exp emin' prec') *)
unfold FTZ_exp.
unfold Prec_gt_0 in *.
(* Goal: double_round_plus_beta_ge_3_hyp (fun e : Z => if Z.ltb (Z.sub e prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub e prec) (fun e : Z => if Z.ltb (Z.sub e prec') emin' then Z.sub (Z.add emin' prec') (Zpos xH) else Z.sub e prec') *)
unfold double_round_plus_beta_ge_3_hyp; split; [|split; [|split]]; intros ex ey.
- destruct (Z.ltb_spec (ex + 1 - prec) emin);
  destruct (Z.ltb_spec (ex - prec') emin');
  destruct (Z.ltb_spec (ey - prec) emin);
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  omega.
- destruct (Z.ltb_spec (ex - 1 - prec) emin);
  destruct (Z.ltb_spec (ex - prec') emin');
  destruct (Z.ltb_spec (ey - prec) emin);
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  omega.
- destruct (Z.ltb_spec (ex - prec) emin);
  destruct (Z.ltb_spec (ex - prec') emin');
  destruct (Z.ltb_spec (ey - prec) emin);
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  omega.
- destruct (Z.ltb_spec (ex - prec') emin');
  destruct (Z.ltb_spec (ey - prec) emin);
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  omega.
Qed.

Theorem double_round_plus_beta_ge_3_FTZ :
  (3 <= beta)%Z ->
  forall choice1 choice2,
  (emin' + prec' <= emin + 1)%Z -> (2 * prec <= prec')%Z ->
  forall x y,
  FTZ_format beta emin prec x -> FTZ_format beta emin prec y ->
  double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec')
                  choice1 choice2 (x + y).
Proof.
(* Goal: forall (_ : Z.le (Zpos (xI xH)) (radix_val beta)) (choice1 choice2 : forall _ : Z, bool) (_ : Z.le (Z.add emin' prec') (Z.add emin (Zpos xH))) (_ : Z.le (Z.mul (Zpos (xO xH)) prec) prec') (x y : R) (_ : FTZ_format beta emin prec x) (_ : FTZ_format beta emin prec y), double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec') choice1 choice2 (Rminus x y) *)
intros Hbeta choice1 choice2 Hemin Hprec x y Fx Fy.
(* Goal: double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec') choice1 choice2 (Rplus x y) *)
apply double_round_plus_beta_ge_3.
- exact Hbeta.
- now apply FTZ_exp_valid.
- now apply FTZ_exp_valid.
- now apply FTZ_double_round_plus_beta_ge_3_hyp.
- now apply generic_format_FTZ.
- now apply generic_format_FTZ.
Qed.

Theorem double_round_minus_beta_ge_3_FTZ :
  (3 <= beta)%Z ->
  forall choice1 choice2,
  (emin' + prec' <= emin + 1)%Z -> (2 * prec <= prec')%Z ->
  forall x y,
  FTZ_format beta emin prec x -> FTZ_format beta emin prec y ->
  double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec')
                  choice1 choice2 (x - y).
Proof.
(* Goal: forall (_ : Z.le (Zpos (xI xH)) (radix_val beta)) (choice1 choice2 : forall _ : Z, bool) (_ : Z.le (Z.add emin' prec') (Z.add emin (Zpos xH))) (_ : Z.le (Z.mul (Zpos (xO xH)) prec) prec') (x y : R) (_ : FTZ_format beta emin prec x) (_ : FTZ_format beta emin prec y), double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec') choice1 choice2 (Rminus x y) *)
intros Hbeta choice1 choice2 Hemin Hprec x y Fx Fy.
(* Goal: double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec') choice1 choice2 (Rminus x y) *)
apply double_round_minus_beta_ge_3.
- exact Hbeta.
- now apply FTZ_exp_valid.
- now apply FTZ_exp_valid.
- now apply FTZ_double_round_plus_beta_ge_3_hyp.
- now apply generic_format_FTZ.
- now apply generic_format_FTZ.
Qed.

End Double_round_plus_beta_ge_3_FTZ.

End Double_round_plus_beta_ge_3.

End Double_round_plus.

Lemma double_round_mid_cases :
  forall (fexp1 fexp2 : Z -> Z),
  Valid_exp fexp1 -> Valid_exp fexp2 ->
  forall (choice1 choice2 : Z -> bool),
  forall x,
  0 < x ->
  (fexp2 (ln_beta x) <= fexp1 (ln_beta x) - 1)%Z ->
  (fexp1 (ln_beta x) <= ln_beta x)%Z ->
  (Rabs (x - midp fexp1 x) <= / 2 * (ulp beta fexp2 x) ->
   double_round_eq fexp1 fexp2 choice1 choice2 x) ->
  double_round_eq fexp1 fexp2 choice1 choice2 x.
Proof.
(* Goal: forall (fexp1 fexp2 : forall _ : Z, Z) (_ : Valid_exp fexp1) (_ : Valid_exp fexp2) (choice1 choice2 : forall _ : Z, bool) (x : R) (_ : Rlt (IZR Z0) x) (_ : Z.le (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Zpos xH))) (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : forall _ : Rle (Rabs (Rminus x (midp fexp1 x))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x)), double_round_eq fexp1 fexp2 choice1 choice2 x), double_round_eq fexp1 fexp2 choice1 choice2 x *)
intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 x Px Hf2f1 Hf1.
(* Goal: forall _ : forall _ : Rle (Rabs (Rminus x (midp fexp1 x))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x)), double_round_eq fexp1 fexp2 choice1 choice2 x, double_round_eq fexp1 fexp2 choice1 choice2 x *)
unfold double_round_eq, midp.
(* Goal: forall _ : @eq R x (Rplus (round beta fexp1 Zfloor x) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 x))), @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)) (round beta fexp1 (Znearest choice1) x) *)
set (rd := round beta fexp1 Zfloor x).
(* Goal: forall (_ : forall (_ : @eq Z (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Z.add (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH))) (_ : Rle (Rminus (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))) x), double_round_eq fexp1 fexp2 choice1 choice2 x) (_ : forall (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : and (Rle (Rminus (midp fexp1 x) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))) x) (Rlt x (midp fexp1 x))), double_round_eq fexp1 fexp2 choice1 choice2 x) (_ : forall (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : @eq R x (midp fexp1 x)), double_round_eq fexp1 fexp2 choice1 choice2 x) (_ : forall (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : and (Rlt (midp fexp1 x) x) (Rle x (Rplus (midp fexp1 x) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))))), double_round_eq fexp1 fexp2 choice1 choice2 x), double_round_eq fexp1 fexp2 choice1 choice2 x *)
set (u1 := ulp beta fexp1 x).
(* Goal: forall (_ : forall (_ : @eq Z (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Z.add (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH))) (_ : Rle (Rminus (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))) x), double_round_eq fexp1 fexp2 choice1 choice2 x) (_ : forall (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : and (Rle (Rminus (midp fexp1 x) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))) x) (Rlt x (midp fexp1 x))), double_round_eq fexp1 fexp2 choice1 choice2 x) (_ : forall (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : @eq R x (midp fexp1 x)), double_round_eq fexp1 fexp2 choice1 choice2 x) (_ : forall (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : and (Rlt (midp fexp1 x) x) (Rle x (Rplus (midp fexp1 x) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))))), double_round_eq fexp1 fexp2 choice1 choice2 x), double_round_eq fexp1 fexp2 choice1 choice2 x *)
set (u2 := ulp beta fexp2 x).
(* Goal: forall _ : forall _ : Rle (Rabs (Rminus x (Rplus rd (Rmult (Rinv (IZR (Zpos (xO xH)))) u1)))) (Rmult (Rinv (IZR (Zpos (xO xH)))) u2), @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)) (round beta fexp1 (Znearest choice1) x), @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)) (round beta fexp1 (Znearest choice1) x) *)
intros Cmid.
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 x *)
destruct (generic_format_EM beta fexp1 x) as [Fx|Nfx].
- (* generic_format beta fexp1 x *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)) (round beta fexp1 (Znearest choice1) x) *)
  rewrite (round_generic beta fexp2); [reflexivity|now apply valid_rnd_N|].
(* Goal: generic_format beta fexp2 x *)
  now apply (generic_inclusion_ln_beta beta fexp1); [omega|].
- (* ~ generic_format beta fexp1 x *)
  assert (Hceil : round beta fexp1 Zceil x = rd + u1);
  [now apply round_UP_DN_ulp|].
  assert (Hf2' : (fexp2 (ln_beta x) <= fexp1 (ln_beta x) - 1)%Z); [omega|].
  destruct (Rlt_or_le (x - rd) (/ 2 * (u1 - u2))).
  + (* x - rd < / 2 * (u1 - u2) *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)) (round beta fexp1 (Znearest choice1) x) *)
    apply double_round_lt_mid_further_place; try assumption.
(* Goal: forall _ : @eq R x (midp fexp1 x), @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)) (round beta fexp1 (Znearest choice1) x) *)
    unfold midp. fold rd; fold u1; fold u2.
    apply (Rplus_lt_reg_r (- rd)); ring_simplify.
    now rewrite <- Rmult_minus_distr_l.
  + (* / 2 * (u1 - u2) <= x - rd *)
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
    { destruct (Rlt_or_le (/ 2 * (u1 + u2)) (x - rd)).
      - (* / 2 * (u1 + u2) < x - rd *)
        assert (round beta fexp1 Zceil x - x
                < / 2 * (ulp beta fexp1 x - ulp beta fexp2 x)).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
        { rewrite Hceil; fold u1; fold u2.
          lra. }
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)) (round beta fexp1 (Znearest choice1) x) *)
        apply double_round_gt_mid_further_place; try assumption.
(* Goal: forall _ : Rlt (Rplus (Rplus x' (Rmult (Rinv (IZR (Zpos (xO xH)))) u1)) (Rmult (Rinv (IZR (Zpos (xO xH)))) u2)) x, Rlt (Rplus (Rminus (Rplus x' u1) (Rmult (Rinv (IZR (Zpos (xO xH)))) u1)) (Rmult (Rinv (IZR (Zpos (xO xH)))) u2)) x *)
        unfold midp'; lra.
      - (* x - rd <= / 2 * (u1 + u2) *)
        apply Cmid, Rabs_le; split; lra. }
Qed.

Section Double_round_sqrt.

Definition double_round_sqrt_hyp fexp1 fexp2 :=
  (forall ex, (2 * fexp1 ex <= fexp1 (2 * ex))%Z)
  /\ (forall ex, (2 * fexp1 ex <= fexp1 (2 * ex - 1))%Z)
  /\ (forall ex, (fexp1 (2 * ex) < 2 * ex)%Z ->
                 (fexp2 ex + ex <= 2 * fexp1 ex - 2)%Z).

Lemma ln_beta_sqrt_disj :
  forall x,
  0 < x ->
  (ln_beta x = 2 * ln_beta (sqrt x) - 1 :> Z)%Z
  \/ (ln_beta x = 2 * ln_beta (sqrt x) :> Z)%Z.
Proof.
(* Goal: forall (x : R) (_ : Rlt (IZR Z0) x), or (@eq Z (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Z.sub (Z.mul (Zpos (xO xH)) (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (Zpos xH))) (@eq Z (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Z.mul (Zpos (xO xH)) (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))))) *)
intros x Px.
(* Goal: or (@eq Z (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Z.sub (Z.mul (Zpos (xO xH)) (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (Zpos xH))) (@eq Z (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Z.mul (Zpos (xO xH)) (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))))) *)
generalize (ln_beta_sqrt beta x Px).
(* Goal: forall (_ : Z.le (fexp1 (ln_beta_val beta (Rdiv x y) (Fcore_Raux.ln_beta beta (Rdiv x y)))) (ln_beta_val beta (Rdiv x y) (Fcore_Raux.ln_beta beta (Rdiv x y)))) (_ : @eq R (Rdiv x y) (midp fexp1 (Rdiv x y))), double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
intro H.
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
omega.
Qed.

Lemma double_round_sqrt_aux :
  forall fexp1 fexp2 : Z -> Z,
  Valid_exp fexp1 -> Valid_exp fexp2 ->
  double_round_sqrt_hyp fexp1 fexp2 ->
  forall x,
  0 < x ->
  (fexp2 (ln_beta (sqrt x)) <= fexp1 (ln_beta (sqrt x)) - 1)%Z ->
  generic_format beta fexp1 x ->
  / 2 * ulp beta fexp2 (sqrt x) < Rabs (sqrt x - midp fexp1 (sqrt x)).
Proof.
(* Goal: forall (fexp1 fexp2 : forall _ : Z, Z) (_ : Valid_exp fexp1) (_ : Valid_exp fexp2) (_ : double_round_sqrt_hyp fexp1 fexp2) (x : R) (_ : Rlt (IZR Z0) x) (_ : Z.le (fexp2 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (Z.sub (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (Zpos xH))) (_ : generic_format beta fexp1 x), Rlt (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 (sqrt x))) (Rabs (Rminus (sqrt x) (midp fexp1 (sqrt x)))) *)
intros fexp1 fexp2 Vfexp1 Vfexp2 Hexp x Px Hf2 Fx.
(* Goal: Rlt (Rinv (Z2R (Z.mul (radix_val beta) (radix_val beta)))) (Rinv (IZR (Zpos (xO xH)))) *)
assert (Hbeta : (2 <= beta)%Z).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ destruct beta as (beta_val,beta_prop).
  now apply Zle_bool_imp_le. }
(* Goal: Rlt (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 (sqrt x))) (Rabs (Rminus (sqrt x) (midp fexp1 (sqrt x)))) *)
set (a := round beta fexp1 Zfloor (sqrt x)).
(* Goal: Rlt (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 (sqrt x))) (Rabs (Rminus (sqrt x) (midp fexp1 (sqrt x)))) *)
set (u1 := bpow (fexp1 (ln_beta (sqrt x)))).
(* Goal: Rlt (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 (sqrt x))) (Rabs (Rminus (sqrt x) (midp fexp1 (sqrt x)))) *)
set (u2 := bpow (fexp2 (ln_beta (sqrt x)))).
set (b := / 2 * (u1 - u2)).
set (b' := / 2 * (u1 + u2)).
(* Goal: Rlt (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 (sqrt x))) (Rabs (Rminus (sqrt x) (midp fexp1 (sqrt x)))) *)
unfold midp; rewrite 2!ulp_neq_0; try now apply Rgt_not_eq, sqrt_lt_R0.
(* Goal: Rlt (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (canonic_exp beta fexp2 (sqrt x)))) (Rabs (Rminus (sqrt x) (Rplus (round beta fexp1 Zfloor (sqrt x)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (canonic_exp beta fexp1 (sqrt x))))))) *)
apply Rnot_ge_lt; intro H; apply Rge_le in H.
(* Goal: False *)
assert (Fa : generic_format beta fexp1 a).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ unfold a.
(* Goal: generic_format beta fexp1 (round beta fexp1 Zfloor (sqrt x)) *)
  apply generic_format_round.
(* Goal: Valid_exp fexp1 *)
  - exact Vfexp1.
  - now apply valid_rnd_DN. }
(* Goal: Rle (Rminus (round beta fexp Zceil (Rminus x y)) (Rminus x y)) y *)
revert Fa; revert Fx.
(* Goal: forall (_ : generic_format beta fexp1 x) (_ : generic_format beta fexp1 a), False *)
unfold generic_format, F2R, scaled_mantissa, canonic_exp; simpl.
set (mx := Ztrunc (x * bpow (- fexp1 (ln_beta x)))).
set (ma := Ztrunc (a * bpow (- fexp1 (ln_beta a)))).
(* Goal: forall (_ : @eq R x (Rmult (Z2R mx) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (_ : @eq R a (Rmult (Z2R ma) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta a (Fcore_Raux.ln_beta beta a)))))), False *)
intros Fx Fa.
(* Goal: False *)
assert (Nna : 0 <= a).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ rewrite <- (round_0 beta fexp1 Zfloor).
(* Goal: Rle (round beta fexp1 Zfloor (IZR Z0)) a *)
  unfold a; apply round_le.
(* Goal: Valid_exp fexp1 *)
  - exact Vfexp1.
  - now apply valid_rnd_DN.
  - apply sqrt_pos. }
assert (Phu1 : 0 < / 2 * u1).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ apply Rmult_lt_0_compat; [lra|apply bpow_gt_0]. }
assert (Phu2 : 0 < / 2 * u2).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ apply Rmult_lt_0_compat; [lra|apply bpow_gt_0]. }
(* Goal: False *)
assert (Pb : 0 < b).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ unfold b.
  rewrite <- (Rmult_0_r (/ 2)).
(* Goal: Rlt (Rmult (Rinv (IZR (Zpos (xO xH)))) (IZR Z0)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus u1 u2)) *)
  apply Rmult_lt_compat_l; [lra|].
(* Goal: Rlt (IZR Z0) (Rminus u1 u2) *)
  apply Rlt_Rminus.
(* Goal: Rlt u2 u1 *)
  unfold u2, u1.
(* Goal: Rlt (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))))) *)
  apply bpow_lt.
  omega. }
(* Goal: False *)
assert (Pb' : 0 < b').
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ now unfold b'; rewrite Rmult_plus_distr_l; apply Rplus_lt_0_compat. }
assert (Hr : sqrt x <= a + b').
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ unfold b'; apply (Rplus_le_reg_r (- / 2 * u1 - a)); ring_simplify.
  replace (_ - _) with (sqrt x - (a + / 2 * u1)) by ring.
  now apply Rabs_le_inv. }
assert (Hl : a + b <= sqrt x).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ unfold b; apply (Rplus_le_reg_r (- / 2 * u1 - a)); ring_simplify.
  replace (_ + sqrt _) with (sqrt x - (a + / 2 * u1)) by ring.
(* Goal: Rle (Rmult (Ropp (Rinv (IZR (Zpos (xO xH))))) u2) (Rminus (sqrt x) (Rplus a (Rmult (Rinv (IZR (Zpos (xO xH)))) u1))) *)
  rewrite Ropp_mult_distr_l_reverse.
  now apply Rabs_le_inv in H; destruct H. }
assert (Hf1 : (2 * fexp1 (ln_beta (sqrt x)) <= fexp1 (ln_beta (x)))%Z);
  [destruct (ln_beta_sqrt_disj x Px) as [H'|H']; rewrite H'; apply Hexp|].
assert (Hlx : (fexp1 (2 * ln_beta (sqrt x)) < 2 * ln_beta (sqrt x))%Z).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ destruct (ln_beta_sqrt_disj x Px) as [Hlx|Hlx].
  - apply (valid_exp_large fexp1 (ln_beta x)); [|omega].
(* Goal: Z.lt (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) *)
    now apply ln_beta_generic_gt; [|apply Rgt_not_eq|].
  - rewrite <- Hlx.
    now apply ln_beta_generic_gt; [|apply Rgt_not_eq|]. }
assert (Hsl : a * a + u1 * a - u2 * a + b * b <= x).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ replace (_ + _) with ((a + b) * (a + b)); [|now unfold b; field].
  rewrite <- sqrt_def; [|now apply Rlt_le].
  assert (H' : 0 <= a + b); [now apply Rlt_le, Rplus_le_lt_0_compat|].
  now apply Rmult_le_compat. }
assert (Hsr : x <= a * a + u1 * a + u2 * a + b' * b').
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ replace (_ + _) with ((a + b') * (a + b')); [|now unfold b'; field].
  rewrite <- (sqrt_def x); [|now apply Rlt_le].
(* Goal: Rle (Rmult (sqrt x) (sqrt x)) (Rmult (Rplus a b') (Rplus a b')) *)
  assert (H' : 0 <= sqrt x); [now apply sqrt_pos|].
  now apply Rmult_le_compat. }
(* Goal: False *)
destruct (Req_dec a 0) as [Za|Nza].
- (* a = 0 *)
(* Goal: False *)
  apply (Rlt_irrefl 0).
  apply Rlt_le_trans with (b * b); [now apply Rmult_lt_0_compat|].
(* Goal: Rle (Rmult b b) (IZR Z0) *)
  apply Rle_trans with x.
  + revert Hsl; unfold Rminus; rewrite Za; do 3 rewrite Rmult_0_r.
(* Goal: forall _ : Rle (Rplus (Rplus (Rplus (IZR Z0) (IZR Z0)) (Ropp (IZR Z0))) (Rmult b b)) x, Rle (Rmult b b) x *)
    now rewrite Ropp_0; do 3 rewrite Rplus_0_l.
  + rewrite Fx.
    apply (Rmult_le_reg_r (bpow (- fexp1 (ln_beta x))));
      [now apply bpow_gt_0|].
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    rewrite Rmult_0_l; bpow_simplify.
(* Goal: Rle (Z2R mx) (IZR Z0) *)
    unfold mx.
    rewrite Ztrunc_floor;
      [|now apply Rmult_le_pos; [apply Rlt_le|apply bpow_ge_0]].
(* Goal: Rle (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (IZR Z0) *)
    apply Req_le.
(* Goal: @eq R (Z2R (Zceil (Rmult (Rminus x y) (Fcore_Raux.bpow beta (Z.opp (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Z2R mx) *)
    change 0 with (Z2R 0); apply f_equal.
(* Goal: @eq Z (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) Z0 *)
    apply Zfloor_imp.
(* Goal: and (Rle (Z2R Z0) (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Rlt (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Z2R (Z.add Z0 (Zpos xH)))) *)
    split; [now apply Rmult_le_pos; [apply Rlt_le|apply bpow_ge_0]|simpl].
(* Goal: Rlt (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (IZR (Zpos xH)) *)
    apply (Rmult_lt_reg_r (bpow (fexp1 (ln_beta x)))); [now apply bpow_gt_0|].
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    rewrite Rmult_1_l; bpow_simplify.
    apply Rlt_le_trans with (bpow (2 * fexp1 (ln_beta (sqrt x))));
      [|now apply bpow_le].
    change 2%Z with (1 + 1)%Z; rewrite Zmult_plus_distr_l; rewrite Zmult_1_l.
(* Goal: Rlt x (Fcore_Raux.bpow beta (Z.add (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))))) *)
    rewrite bpow_plus.
    rewrite <- (sqrt_def x) at 1; [|now apply Rlt_le].
    assert (sqrt x < bpow (fexp1 (ln_beta (sqrt x))));
      [|now apply Rmult_lt_compat; [apply sqrt_pos|apply sqrt_pos| |]].
(* Goal: Rlt (sqrt x) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))))) *)
    apply (Rle_lt_trans _ _ _ Hr); rewrite Za; rewrite Rplus_0_l.
(* Goal: Rlt b' (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))))) *)
    unfold b'; change (bpow _) with u1.
    apply Rlt_le_trans with (/ 2 * (u1 + u1)); [|lra].
(* Goal: Rlt (Rplus a (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta a (Fcore_Raux.ln_beta beta a)))))) (Rplus a (ulp beta fexp1 a)) *)
    apply Rmult_lt_compat_l; [lra|]; apply Rplus_lt_compat_l.
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
    unfold u2, u1, ulp, canonic_exp; apply bpow_lt; omega.
- (* a <> 0 *)
(* Goal: False *)
  assert (Pa : 0 < a); [lra|].
(* Goal: False *)
  assert (Hla : (ln_beta a = ln_beta (sqrt x) :> Z)).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
  { unfold a; apply ln_beta_DN.
(* Goal: Valid_exp fexp1 *)
    - exact Vfexp1.
    - now fold a. }
  assert (Hl' : 0 < - (u2 * a) + b * b).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
  { apply (Rplus_lt_reg_r (u2 * a)); ring_simplify.
(* Goal: Rlt (Rplus (Rminus (round beta fexp1 Zceil (Rminus x y)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y)))) (Rminus (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y))) (Rminus x y))) (Rplus (Rminus x y) (Rminus (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y))) (Rminus x y))) *)
    unfold b; ring_simplify.
    apply (Rplus_lt_reg_r (/ 2 * u2 * u1)); field_simplify.
    replace (_ / 2) with (u2 * (a + / 2 * u1)) by field.
    replace (_ / 8) with (/ 4 * (u2 ^ 2 + u1 ^ 2)) by field.
    apply Rlt_le_trans with (u2 * bpow (ln_beta (sqrt x))).
    - apply Rmult_lt_compat_l; [now unfold u2, ulp; apply bpow_gt_0|].
      unfold u1; rewrite <- Hla.
      apply Rlt_le_trans with (a + bpow (fexp1 (ln_beta a))).
      + apply Rplus_lt_compat_l.
        rewrite <- (Rmult_1_l (bpow _)) at 2.
(* Goal: Rlt (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta a (Fcore_Raux.ln_beta beta a))))) (Rmult (IZR (Zpos xH)) (Fcore_Raux.bpow beta (canonic_exp beta fexp1 a))) *)
        apply Rmult_lt_compat_r; [apply bpow_gt_0|lra].
      + apply Rle_trans with (a+ ulp beta fexp1 a).
(* Goal: Rle (Rplus a (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta a (Fcore_Raux.ln_beta beta a))))) (Rplus a (ulp beta fexp1 a)) *)
(* Goal: Rle (Rplus a (ulp beta fexp1 a)) (Fcore_Raux.bpow beta (ln_beta_val beta a (Fcore_Raux.ln_beta beta a))) *)
        right; now rewrite ulp_neq_0.
(* Goal: Rle (Rplus a (ulp beta fexp1 a)) (Fcore_Raux.bpow beta (ln_beta_val beta a (Fcore_Raux.ln_beta beta a))) *)
        apply (id_p_ulp_le_bpow _ _ _ _ Pa Fa).
(* Goal: Rlt a (Fcore_Raux.bpow beta (ln_beta_val beta a (Fcore_Raux.ln_beta beta a))) *)
        apply Rabs_lt_inv, bpow_ln_beta_gt.
    - apply Rle_trans with (bpow (- 2) * u1 ^ 2).
      + unfold pow; rewrite Rmult_1_r.
(* Goal: Rle (Fcore_Raux.bpow beta (Z.add (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))) (fexp2 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))))) (Fcore_Raux.bpow beta (Z.sub (Z.mul (Zpos (xO xH)) (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))))) (Zpos xH))) *)
        unfold u1, u2, ulp, canonic_exp; bpow_simplify; apply bpow_le.
(* Goal: Z.le (Z.add (fexp2 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (Z.sub (Z.mul (Zpos (xO xH)) (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))))) (Zpos xH)) *)
        now apply Hexp.
      + apply Rmult_le_compat.
        * apply bpow_ge_0.
        * apply pow2_ge_0.
        * unfold Fcore_Raux.bpow, Z.pow_pos; simpl; rewrite Zmult_1_r.
(* Goal: Rle (Rinv (Z2R (radix_val beta))) (Rinv (IZR (Zpos (xO xH)))) *)
          apply Rinv_le; [lra|].
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
          change 4 with (Z2R (2 * 2)%Z); apply Z2R_le, Zmult_le_compat; omega.
        * rewrite <- (Rplus_0_l (u1 ^ 2)) at 1; apply Rplus_le_compat_r.
          apply pow2_ge_0. }
  assert (Hr' : x <= a * a + u1 * a).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
  { rewrite Hla in Fa.
    rewrite <- Rmult_plus_distr_r.
(* Goal: Rle x (Rmult (Rplus a u1) a) *)
    unfold u1, ulp, canonic_exp.
    rewrite <- (Rmult_1_l (bpow _)); rewrite Fa; rewrite <- Rmult_plus_distr_r.
    rewrite <- Rmult_assoc; rewrite (Rmult_comm _ (Z2R ma)).
    rewrite <- (Rmult_assoc (Z2R ma)); bpow_simplify.
    apply (Rmult_le_reg_r (bpow (- 2 * fexp1 (ln_beta (sqrt x)))));
      [now apply bpow_gt_0|bpow_simplify].
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    rewrite Fx at 1; bpow_simplify.
    rewrite <- Z2R_Zpower; [|omega].
    change 1 with (Z2R 1); rewrite <- Z2R_plus; do 2 rewrite <- Z2R_mult.
(* Goal: Rle (Z2R (Z.mul mx (Z.pow (radix_val beta) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Z.mul (Zpos (xO xH)) (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))))))))) (Z2R (Z.mul ma (Z.add ma (Zpos xH)))) *)
    apply Z2R_le, Zlt_succ_le, lt_Z2R.
(* Goal: Rlt (Z2R (Z.mul (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Z.pow (radix_val beta) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Z2R (Z.add (Z.mul (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Z.pow (radix_val beta) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Zpos xH))) *)
    unfold Z.succ; rewrite Z2R_plus; do 2 rewrite Z2R_mult; rewrite Z2R_plus.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Z2R (Z.pow (radix_val beta) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    rewrite Z2R_Zpower; [|omega].
    apply (Rmult_lt_reg_r (bpow (2 * fexp1 (ln_beta (sqrt x)))));
      [now apply bpow_gt_0|bpow_simplify].
    rewrite <- Fx.
    change 2%Z with (1 + 1)%Z; rewrite Zmult_plus_distr_l; rewrite Zmult_1_l.
(* Goal: Rlt x (Rmult (Rplus (Rmult (Z2R ma) (Rplus (Z2R ma) (Z2R (Zpos xH)))) (Z2R (Zpos xH))) (Fcore_Raux.bpow beta (Z.add (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))))))) *)
    rewrite bpow_plus; simpl.
    replace (_ * _) with (a * a + u1 * a + u1 * u1);
      [|unfold u1, ulp, canonic_exp; rewrite Fa; ring].
(* Goal: Rlt x (Rplus (Rplus (Rmult a a) (Rmult u1 a)) (Rmult u1 u1)) *)
    apply (Rle_lt_trans _ _ _ Hsr).
(* Goal: Rlt (Rplus a (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta a (Fcore_Raux.ln_beta beta a)))))) (Rplus a (ulp beta fexp1 a)) *)
    rewrite Rplus_assoc; apply Rplus_lt_compat_l.
    apply (Rplus_lt_reg_r (- b' * b' + / 2 * u1 * u2)); ring_simplify.
    replace (_ + _) with ((a + / 2 * u1) * u2) by ring.
    apply Rlt_le_trans with (bpow (ln_beta (sqrt x)) * u2).
    - apply Rmult_lt_compat_r; [now unfold u2, ulp; apply bpow_gt_0|].
      apply Rlt_le_trans with (a + u1); [lra|].
(* Goal: Rle (Rplus a u1) (Fcore_Raux.bpow beta (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) *)
      unfold u1; fold (canonic_exp beta fexp1 (sqrt x)).
      rewrite <- canonic_exp_DN; [|exact Vfexp1|exact Pa]; fold a.
      rewrite <- ulp_neq_0; trivial.
(* Goal: Rle (Rplus a (ulp beta fexp1 a)) (Fcore_Raux.bpow beta (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) *)
      apply id_p_ulp_le_bpow.
      + exact Pa.
(* Goal: Rle (IZR Z0) rd *)
      + now apply round_DN_pt.
      + apply Rle_lt_trans with (sqrt x).
(* Goal: Rle (IZR Z0) rd *)
        * now apply round_DN_pt.
        * apply Rabs_lt_inv.
(* Goal: Rlt (Rabs (sqrt x)) (Fcore_Raux.bpow beta (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) *)
          apply bpow_ln_beta_gt.
    - apply Rle_trans with (/ 2 * u1 ^ 2).
      + apply Rle_trans with (bpow (- 2) * u1 ^ 2).
        * unfold pow; rewrite Rmult_1_r.
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) u2) (Rmult (Fcore_Raux.bpow beta (Zneg xH)) (Rmult u1 u1)) *)
          unfold u2, u1, ulp, canonic_exp.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
          bpow_simplify.
(* Goal: Rle (Fcore_Raux.bpow beta (Z.add (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))) (fexp2 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))))) (Fcore_Raux.bpow beta (Z.sub (Z.mul (Zpos (xO xH)) (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))))) (Zpos xH))) *)
          apply bpow_le.
(* Goal: Z.le (Z.add (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))) (fexp2 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))))) (Z.sub (Z.mul (Zpos (xO xH)) (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))))) (Zpos xH)) *)
          rewrite Zplus_comm.
(* Goal: Z.le (Z.add (fexp2 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (Z.sub (Z.mul (Zpos (xO xH)) (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))))) (Zpos xH)) *)
          now apply Hexp.
        * apply Rmult_le_compat_r; [now apply pow2_ge_0|].
(* Goal: Rle (Fcore_Raux.bpow beta (Zneg xH)) (Rinv (IZR (Zpos (xO xH)))) *)
          unfold Fcore_Raux.bpow; simpl; unfold Z.pow_pos; simpl.
(* Goal: @eq R (Rplus (Rmult (Z2R (Zfloor (scaled_mantissa beta fexp2 rd))) (Fcore_Raux.bpow beta (canonic_exp beta fexp2 x))) (Rmult (Rmult (Z2R n) (Rinv (Z2R (Z.mul (radix_val beta) (Zpos xH))))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) x *)
          rewrite Zmult_1_r.
(* Goal: Rle (Rinv (Z2R (radix_val beta))) (Rinv (IZR (Zpos (xO xH)))) *)
          apply Rinv_le; [lra|].
(* Goal: Rle (Z2R (Zceil (Rmult (Rminus x y) (Fcore_Raux.bpow beta (Z.opp (fexp (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH)))))))) (Z2R (Z.pow (radix_val beta) (Z.sub (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (fexp (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH)))) (Zpos xH)))) *)
          change 2 with (Z2R 2); apply Z2R_le.
          rewrite <- (Zmult_1_l 2).
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
          apply Zmult_le_compat; omega.
      + assert (u2 ^ 2 < u1 ^ 2); [|unfold b'; lra].
(* Goal: Rlt (pow u2 (S (S O))) (pow u1 (S (S O))) *)
        unfold pow; do 2 rewrite Rmult_1_r.
(* Goal: Rlt (Rmult u2 u2) (Rmult u1 u1) *)
        assert (H' : 0 <= u2); [unfold u2, ulp; apply bpow_ge_0|].
(* Goal: Rlt (Rmult u2 u2) (Rmult u1 u1) *)
        assert (u2 < u1); [|now apply Rmult_lt_compat].
        unfold u1, u2, ulp, canonic_exp; apply bpow_lt; omega. }
  apply (Rlt_irrefl (a * a + u1 * a)).
  apply Rlt_le_trans with (a * a + u1 * a - u2 * a + b * b).
  + rewrite <- (Rplus_0_r (a * a + _)) at 1.
    unfold Rminus; rewrite (Rplus_assoc _ _ (b * b)).
(* Goal: Rlt (Rplus a (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta a (Fcore_Raux.ln_beta beta a)))))) (Rplus a (ulp beta fexp1 a)) *)
    now apply Rplus_lt_compat_l.
  + now apply Rle_trans with x.
Qed.


Lemma double_round_sqrt :
  forall fexp1 fexp2 : Z -> Z,
  Valid_exp fexp1 -> Valid_exp fexp2 ->
  forall (choice1 choice2 : Z -> bool),
  double_round_sqrt_hyp fexp1 fexp2 ->
  forall x,
  generic_format beta fexp1 x ->
  double_round_eq fexp1 fexp2 choice1 choice2 (sqrt x).
Proof.
(* Goal: forall (fexp1 fexp2 : forall _ : Z, Z) (_ : Valid_exp fexp1) (_ : Valid_exp fexp2) (choice1 choice2 : forall _ : Z, bool) (_ : double_round_sqrt_hyp fexp1 fexp2) (x : R) (_ : generic_format beta fexp1 x), double_round_eq fexp1 fexp2 choice1 choice2 (sqrt x) *)
intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x Fx.
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
unfold double_round_eq.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (sqrt x))) (round beta fexp1 (Znearest choice1) (sqrt x)) *)
destruct (Rle_or_lt x 0) as [Npx|Px].
- (* x <= 0 *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (sqrt x))) (round beta fexp1 (Znearest choice1) (sqrt x)) *)
  rewrite (sqrt_neg _ Npx).
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (IZR Z0))) (round beta fexp1 (Znearest choice1) (IZR Z0)) *)
  now rewrite round_0; [|apply valid_rnd_N].
- (* 0 < x *)
  assert (Hfx : (fexp1 (ln_beta x) < ln_beta x)%Z);
  [now apply ln_beta_generic_gt; try assumption; lra|].
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (sqrt x))) (round beta fexp1 (Znearest choice1) (sqrt x)) *)
  assert (Hfsx : (fexp1 (ln_beta (sqrt x)) < ln_beta (sqrt x))%Z).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
  { destruct (Rle_or_lt x 1) as [Hx|Hx].
    - (* x <= 1 *)
(* Goal: Z.lt (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))) *)
      apply (valid_exp_large fexp1 (ln_beta x)); [exact Hfx|].
(* Goal: Z.le (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))) *)
      apply ln_beta_le; [exact Px|].
      rewrite <- (sqrt_def x) at 1; [|lra].
      rewrite <- Rmult_1_r.
(* Goal: Rle (Rmult (sqrt x) (sqrt x)) (Rmult (sqrt x) (IZR (Zpos xH))) *)
      apply Rmult_le_compat_l.
      + apply sqrt_pos.
      + rewrite <- sqrt_1.
(* Goal: Rle (sqrt x) (sqrt (IZR (Zpos xH))) *)
        now apply sqrt_le_1_alt.
    - (* 1 < x *)
(* Goal: Z.lt (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))) *)
      generalize ((proj1 (proj2 Hexp)) 1%Z).
      replace (_ - 1)%Z with 1%Z by ring.
(* Goal: forall _ : Z.le (Z.mul (Zpos (xO xH)) (fexp1 (Zpos xH))) (fexp1 (Zpos xH)), Z.lt (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))) *)
      intro Hexp10.
(* Goal: Z.lt (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))) *)
      assert (Hf0 : (fexp1 1 < 1)%Z); [omega|clear Hexp10].
(* Goal: Z.lt (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))) *)
      apply (valid_exp_large fexp1 1); [exact Hf0|].
(* Goal: Z.le (Zpos xH) (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))) *)
      apply ln_beta_ge_bpow.
(* Goal: Rle (Fcore_Raux.bpow beta (Z.sub (Zpos xH) (Zpos xH))) (Rabs (sqrt x)) *)
      rewrite Zeq_minus; [|reflexivity].
(* Goal: Rle (Fcore_Raux.bpow beta Z0) (Rabs (sqrt x)) *)
      unfold Fcore_Raux.bpow; simpl.
(* Goal: Rle (IZR (Zpos xH)) (Rabs (sqrt x)) *)
      apply Rabs_ge; right.
      rewrite <- sqrt_1.
(* Goal: Rle (sqrt (IZR (Zpos xH))) (sqrt x) *)
      apply sqrt_le_1_alt.
      now apply Rlt_le. }
  assert (Hf2 : (fexp2 (ln_beta (sqrt x)) <= fexp1 (ln_beta (sqrt x)) - 1)%Z).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
  { assert (H : (fexp1 (2 * ln_beta (sqrt x)) < 2 * ln_beta (sqrt x))%Z).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
    { destruct (ln_beta_sqrt_disj x Px) as [Hlx|Hlx].
      - apply (valid_exp_large fexp1 (ln_beta x)); [|omega].
(* Goal: Z.lt (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) *)
        now apply ln_beta_generic_gt; [|apply Rgt_not_eq|].
      - rewrite <- Hlx.
        now apply ln_beta_generic_gt; [|apply Rgt_not_eq|]. }
(* Goal: Z.le (fexp2 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (Z.sub (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (Zpos xH)) *)
    generalize ((proj2 (proj2 Hexp)) (ln_beta (sqrt x)) H).
    omega. }
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (sqrt x))) (round beta fexp1 (Znearest choice1) (sqrt x)) *)
  apply double_round_mid_cases.
(* Goal: Valid_exp fexp1 *)
  + exact Vfexp1.
  + exact Vfexp2.
  + now apply sqrt_lt_R0.
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  + omega.
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  + omega.
  + intros Hmid; casetype False; apply (Rle_not_lt _ _ Hmid).
(* Goal: Rlt (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 (sqrt x))) (Rabs (Rminus (sqrt x) (midp fexp1 (sqrt x)))) *)
    apply (double_round_sqrt_aux fexp1 fexp2 Vfexp1 Vfexp2 Hexp x Px Hf2 Fx).
Qed.

Section Double_round_sqrt_FLX.

Import Fcore_FLX.

Variable prec : Z.
Variable prec' : Z.

(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
Context { prec_gt_0_ : Prec_gt_0 prec }.
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
Context { prec_gt_0_' : Prec_gt_0 prec' }.

Lemma FLX_double_round_sqrt_hyp :
  (2 * prec + 2 <= prec')%Z ->
  double_round_sqrt_hyp (FLX_exp prec) (FLX_exp prec').
Proof.
(* Goal: forall _ : Z.le (Z.mul (Zpos (xO xH)) prec) prec', double_round_div_hyp (FLX_exp prec) (FLX_exp prec') *)
intros Hprec.
(* Goal: double_round_div_hyp (FLX_exp prec) (FLX_exp prec') *)
unfold FLX_exp.
(* Goal: double_round_div_hyp (fun e : Z => if Z.ltb (Z.sub e prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub e prec) (fun e : Z => if Z.ltb (Z.sub e prec') emin' then Z.sub (Z.add emin' prec') (Zpos xH) else Z.sub e prec') *)
unfold Prec_gt_0 in prec_gt_0_.
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
unfold double_round_sqrt_hyp; split; [|split]; intro ex; omega.
Qed.

Theorem double_round_sqrt_FLX :
  forall choice1 choice2,
  (2 * prec + 2 <= prec')%Z ->
  forall x,
  FLX_format beta prec x ->
  double_round_eq (FLX_exp prec) (FLX_exp prec') choice1 choice2 (sqrt x).
Proof.
(* Goal: forall (choice1 choice2 : forall _ : Z, bool) (_ : Z.le (Z.add (Z.mul (Zpos (xO xH)) prec) (Zpos (xO xH))) prec') (x : R) (_ : FLX_format beta prec x), double_round_eq (FLX_exp prec) (FLX_exp prec') choice1 choice2 (sqrt x) *)
intros choice1 choice2 Hprec x Fx.
(* Goal: double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec') choice1 choice2 (sqrt x) *)
apply double_round_sqrt.
- now apply FLX_exp_valid.
- now apply FLX_exp_valid.
- now apply FLX_double_round_sqrt_hyp.
- now apply generic_format_FLX.
Qed.

End Double_round_sqrt_FLX.

Section Double_round_sqrt_FLT.

Import Fcore_FLX.
Import Fcore_FLT.

Variable emin prec : Z.
Variable emin' prec' : Z.

(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
Context { prec_gt_0_ : Prec_gt_0 prec }.
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
Context { prec_gt_0_' : Prec_gt_0 prec' }.

Lemma FLT_double_round_sqrt_hyp :
  (emin <= 0)%Z ->
  ((emin' <= emin - prec - 2)%Z
   \/ (2 * emin' <= emin - 4 * prec - 2)%Z) ->
  (2 * prec + 2 <= prec')%Z ->
  double_round_sqrt_hyp (FLT_exp emin prec) (FLT_exp emin' prec').
Proof.
(* Goal: forall (_ : Z.le emin Z0) (_ : or (Z.le emin' (Z.sub (Z.sub emin prec) (Zpos xH))) (Z.le (Z.mul (Zpos (xO xH)) emin') (Z.sub emin (Z.mul (Zpos (xO (xO xH))) prec)))) (_ : Z.le (Z.add (Z.mul (Zpos (xO xH)) prec) (Zpos xH)) prec'), double_round_sqrt_beta_ge_4_hyp (FLT_exp emin prec) (FLT_exp emin' prec') *)
intros Hemin Heminprec Hprec.
(* Goal: double_round_div_hyp (FLT_exp emin prec) (FLT_exp emin' prec') *)
unfold FLT_exp.
(* Goal: double_round_div_hyp (fun e : Z => if Z.ltb (Z.sub e prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub e prec) (fun e : Z => if Z.ltb (Z.sub e prec') emin' then Z.sub (Z.add emin' prec') (Zpos xH) else Z.sub e prec') *)
unfold Prec_gt_0 in prec_gt_0_.
(* Goal: double_round_sqrt_hyp (fun e : Z => if Z.ltb (Z.sub e prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub e prec) (fun e : Z => if Z.ltb (Z.sub e prec') emin' then Z.sub (Z.add emin' prec') (Zpos xH) else Z.sub e prec') *)
unfold double_round_sqrt_hyp; split; [|split]; intros ex.
- generalize (Zmax_spec (ex - prec) emin).
  generalize (Zmax_spec (2 * ex - prec) emin).
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  omega.
- generalize (Zmax_spec (ex - prec) emin).
  generalize (Zmax_spec (2 * ex - 1 - prec) emin).
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  omega.
- generalize (Zmax_spec (2 * ex - prec) emin).
  generalize (Zmax_spec (ex - prec') emin').
  generalize (Zmax_spec (ex - prec) emin).
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  omega.
Qed.

Theorem double_round_sqrt_FLT :
  forall choice1 choice2,
  (emin <= 0)%Z ->
  ((emin' <= emin - prec - 2)%Z
   \/ (2 * emin' <= emin - 4 * prec - 2)%Z) ->
  (2 * prec + 2 <= prec')%Z ->
  forall x,
  FLT_format beta emin prec x ->
  double_round_eq (FLT_exp emin prec) (FLT_exp emin' prec')
                  choice1 choice2 (sqrt x).
Proof.
(* Goal: forall (choice1 choice2 : forall _ : Z, bool) (_ : Z.le emin Z0) (_ : or (Z.le emin' (Z.sub (Z.sub emin prec) (Zpos (xO xH)))) (Z.le (Z.mul (Zpos (xO xH)) emin') (Z.sub (Z.sub emin (Z.mul (Zpos (xO (xO xH))) prec)) (Zpos (xO xH))))) (_ : Z.le (Z.add (Z.mul (Zpos (xO xH)) prec) (Zpos (xO xH))) prec') (x : R) (_ : FLT_format beta emin prec x), double_round_eq (FLT_exp emin prec) (FLT_exp emin' prec') choice1 choice2 (sqrt x) *)
intros choice1 choice2 Hemin Heminprec Hprec x Fx.
(* Goal: double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec') choice1 choice2 (sqrt x) *)
apply double_round_sqrt.
- now apply FLT_exp_valid.
- now apply FLT_exp_valid.
- now apply FLT_double_round_sqrt_hyp.
- now apply generic_format_FLT.
Qed.

End Double_round_sqrt_FLT.

Section Double_round_sqrt_FTZ.

Import Fcore_FLX.
Import Fcore_FTZ.

Variable emin prec : Z.
Variable emin' prec' : Z.

(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
Context { prec_gt_0_ : Prec_gt_0 prec }.
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
Context { prec_gt_0_' : Prec_gt_0 prec' }.

Lemma FTZ_double_round_sqrt_hyp :
  (2 * (emin' + prec') <= emin + prec <= 1)%Z ->
  (2 * prec + 2 <= prec')%Z ->
  double_round_sqrt_hyp (FTZ_exp emin prec) (FTZ_exp emin' prec').
Proof.
(* Goal: forall (_ : Z.le (Z.add emin' prec') (Z.sub emin (Zpos xH))) (_ : Z.le (Z.mul (Zpos (xO xH)) prec) prec'), double_round_div_hyp (FTZ_exp emin prec) (FTZ_exp emin' prec') *)
intros Hemin Hprec.
(* Goal: double_round_div_hyp (FTZ_exp emin prec) (FTZ_exp emin' prec') *)
unfold FTZ_exp.
unfold Prec_gt_0 in *.
(* Goal: double_round_sqrt_hyp (fun e : Z => if Z.ltb (Z.sub e prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub e prec) (fun e : Z => if Z.ltb (Z.sub e prec') emin' then Z.sub (Z.add emin' prec') (Zpos xH) else Z.sub e prec') *)
unfold double_round_sqrt_hyp; split; [|split]; intros ex.
- destruct (Z.ltb_spec (ex - prec) emin);
  destruct (Z.ltb_spec (2 * ex - prec) emin);
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  omega.
- destruct (Z.ltb_spec (ex - prec) emin);
  destruct (Z.ltb_spec (2 * ex - 1 - prec) emin);
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  omega.
- intro H.
  destruct (Zle_or_lt emin (2 * ex - prec)) as [H'|H'].
  + destruct (Z.ltb_spec (ex - prec') emin');
    destruct (Z.ltb_spec (ex - prec) emin);
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
    omega.
  + casetype False.
(* Goal: False *)
    rewrite (Zlt_bool_true _ _ H') in H.
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
    omega.
Qed.

Theorem double_round_sqrt_FTZ :
  (4 <= beta)%Z ->
  forall choice1 choice2,
  (2 * (emin' + prec') <= emin + prec <= 1)%Z ->
  (2 * prec + 2 <= prec')%Z ->
  forall x,
  FTZ_format beta emin prec x ->
  double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec')
                  choice1 choice2 (sqrt x).
Proof.
(* Goal: forall (_ : Z.le (Zpos (xO (xO xH))) (radix_val beta)) (choice1 choice2 : forall _ : Z, bool) (_ : and (Z.le (Z.mul (Zpos (xO xH)) (Z.add emin' prec')) (Z.add emin prec)) (Z.le (Z.add emin prec) (Zpos xH))) (_ : Z.le (Z.add (Z.mul (Zpos (xO xH)) prec) (Zpos xH)) prec') (x : R) (_ : FTZ_format beta emin prec x), double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec') choice1 choice2 (sqrt x) *)
intros Hbeta choice1 choice2 Hemin Hprec x Fx.
(* Goal: double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec') choice1 choice2 (sqrt x) *)
apply double_round_sqrt.
- now apply FTZ_exp_valid.
- now apply FTZ_exp_valid.
- now apply FTZ_double_round_sqrt_hyp.
- now apply generic_format_FTZ.
Qed.

End Double_round_sqrt_FTZ.

Section Double_round_sqrt_beta_ge_4.

Definition double_round_sqrt_beta_ge_4_hyp fexp1 fexp2 :=
  (forall ex, (2 * fexp1 ex <= fexp1 (2 * ex))%Z)
  /\ (forall ex, (2 * fexp1 ex <= fexp1 (2 * ex - 1))%Z)
  /\ (forall ex, (fexp1 (2 * ex) < 2 * ex)%Z ->
                 (fexp2 ex + ex <= 2 * fexp1 ex - 1)%Z).

Lemma double_round_sqrt_beta_ge_4_aux :
  (4 <= beta)%Z ->
  forall fexp1 fexp2 : Z -> Z,
  Valid_exp fexp1 -> Valid_exp fexp2 ->
  double_round_sqrt_beta_ge_4_hyp fexp1 fexp2 ->
  forall x,
  0 < x ->
  (fexp2 (ln_beta (sqrt x)) <= fexp1 (ln_beta (sqrt x)) - 1)%Z ->
  generic_format beta fexp1 x ->
  / 2 * ulp beta fexp2 (sqrt x) < Rabs (sqrt x - midp fexp1 (sqrt x)).
Proof.
(* Goal: forall (_ : Z.le (Zpos (xO (xO xH))) (radix_val beta)) (fexp1 fexp2 : forall _ : Z, Z) (_ : Valid_exp fexp1) (_ : Valid_exp fexp2) (_ : double_round_sqrt_beta_ge_4_hyp fexp1 fexp2) (x : R) (_ : Rlt (IZR Z0) x) (_ : Z.le (fexp2 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (Z.sub (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (Zpos xH))) (_ : generic_format beta fexp1 x), Rlt (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 (sqrt x))) (Rabs (Rminus (sqrt x) (midp fexp1 (sqrt x)))) *)
intros Hbeta fexp1 fexp2 Vfexp1 Vfexp2 Hexp x Px Hf2 Fx.
(* Goal: Rlt (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 (sqrt x))) (Rabs (Rminus (sqrt x) (midp fexp1 (sqrt x)))) *)
set (a := round beta fexp1 Zfloor (sqrt x)).
(* Goal: Rlt (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 (sqrt x))) (Rabs (Rminus (sqrt x) (midp fexp1 (sqrt x)))) *)
set (u1 := bpow (fexp1 (ln_beta (sqrt x)))).
(* Goal: Rlt (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 (sqrt x))) (Rabs (Rminus (sqrt x) (midp fexp1 (sqrt x)))) *)
set (u2 := bpow (fexp2 (ln_beta (sqrt x)))).
set (b := / 2 * (u1 - u2)).
set (b' := / 2 * (u1 + u2)).
(* Goal: Rlt (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 (sqrt x))) (Rabs (Rminus (sqrt x) (midp fexp1 (sqrt x)))) *)
unfold midp; rewrite 2!ulp_neq_0; try now apply Rgt_not_eq, sqrt_lt_R0.
(* Goal: Rlt (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (canonic_exp beta fexp2 (sqrt x)))) (Rabs (Rminus (sqrt x) (Rplus (round beta fexp1 Zfloor (sqrt x)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (canonic_exp beta fexp1 (sqrt x))))))) *)
apply Rnot_ge_lt; intro H; apply Rge_le in H.
(* Goal: False *)
assert (Fa : generic_format beta fexp1 a).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ unfold a.
(* Goal: generic_format beta fexp1 (round beta fexp1 Zfloor (sqrt x)) *)
  apply generic_format_round.
(* Goal: Valid_exp fexp1 *)
  - exact Vfexp1.
  - now apply valid_rnd_DN. }
(* Goal: Rle (Rminus (round beta fexp Zceil (Rminus x y)) (Rminus x y)) y *)
revert Fa; revert Fx.
(* Goal: forall (_ : generic_format beta fexp1 x) (_ : generic_format beta fexp1 a), False *)
unfold generic_format, F2R, scaled_mantissa, canonic_exp; simpl.
set (mx := Ztrunc (x * bpow (- fexp1 (ln_beta x)))).
set (ma := Ztrunc (a * bpow (- fexp1 (ln_beta a)))).
(* Goal: forall (_ : @eq R x (Rmult (Z2R mx) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (_ : @eq R a (Rmult (Z2R ma) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta a (Fcore_Raux.ln_beta beta a)))))), False *)
intros Fx Fa.
(* Goal: False *)
assert (Nna : 0 <= a).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ rewrite <- (round_0 beta fexp1 Zfloor).
(* Goal: Rle (round beta fexp1 Zfloor (IZR Z0)) a *)
  unfold a; apply round_le.
(* Goal: Valid_exp fexp1 *)
  - exact Vfexp1.
  - now apply valid_rnd_DN.
  - apply sqrt_pos. }
assert (Phu1 : 0 < / 2 * u1).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ apply Rmult_lt_0_compat; [lra|apply bpow_gt_0]. }
assert (Phu2 : 0 < / 2 * u2).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ apply Rmult_lt_0_compat; [lra|apply bpow_gt_0]. }
(* Goal: False *)
assert (Pb : 0 < b).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ unfold b.
  rewrite <- (Rmult_0_r (/ 2)).
(* Goal: Rlt (Rmult (Rinv (IZR (Zpos (xO xH)))) (IZR Z0)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus u1 u2)) *)
  apply Rmult_lt_compat_l; [lra|].
(* Goal: Rlt (IZR Z0) (Rminus u1 u2) *)
  apply Rlt_Rminus.
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) u2) (Rmult (Fcore_Raux.bpow beta (Zneg xH)) (Rmult u1 u1)) *)
  unfold u2, u1, ulp, canonic_exp.
(* Goal: Rlt (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))))) *)
  apply bpow_lt.
  omega. }
(* Goal: False *)
assert (Pb' : 0 < b').
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ now unfold b'; rewrite Rmult_plus_distr_l; apply Rplus_lt_0_compat. }
assert (Hr : sqrt x <= a + b').
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ unfold b'; apply (Rplus_le_reg_r (- / 2 * u1 - a)); ring_simplify.
  replace (_ - _) with (sqrt x - (a + / 2 * u1)) by ring.
  now apply Rabs_le_inv. }
assert (Hl : a + b <= sqrt x).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ unfold b; apply (Rplus_le_reg_r (- / 2 * u1 - a)); ring_simplify.
  replace (_ + sqrt _) with (sqrt x - (a + / 2 * u1)) by ring.
(* Goal: Rle (Rmult (Ropp (Rinv (IZR (Zpos (xO xH))))) u2) (Rminus (sqrt x) (Rplus a (Rmult (Rinv (IZR (Zpos (xO xH)))) u1))) *)
  rewrite Ropp_mult_distr_l_reverse.
  now apply Rabs_le_inv in H; destruct H. }
assert (Hf1 : (2 * fexp1 (ln_beta (sqrt x)) <= fexp1 (ln_beta (x)))%Z);
  [destruct (ln_beta_sqrt_disj x Px) as [H'|H']; rewrite H'; apply Hexp|].
assert (Hlx : (fexp1 (2 * ln_beta (sqrt x)) < 2 * ln_beta (sqrt x))%Z).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ destruct (ln_beta_sqrt_disj x Px) as [Hlx|Hlx].
  - apply (valid_exp_large fexp1 (ln_beta x)); [|omega].
(* Goal: Z.lt (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) *)
    now apply ln_beta_generic_gt; [|apply Rgt_not_eq|].
  - rewrite <- Hlx.
    now apply ln_beta_generic_gt; [|apply Rgt_not_eq|]. }
assert (Hsl : a * a + u1 * a - u2 * a + b * b <= x).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ replace (_ + _) with ((a + b) * (a + b)); [|now unfold b; field].
  rewrite <- sqrt_def; [|now apply Rlt_le].
  assert (H' : 0 <= a + b); [now apply Rlt_le, Rplus_le_lt_0_compat|].
  now apply Rmult_le_compat. }
assert (Hsr : x <= a * a + u1 * a + u2 * a + b' * b').
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ replace (_ + _) with ((a + b') * (a + b')); [|now unfold b'; field].
  rewrite <- (sqrt_def x); [|now apply Rlt_le].
(* Goal: Rle (Rmult (sqrt x) (sqrt x)) (Rmult (Rplus a b') (Rplus a b')) *)
  assert (H' : 0 <= sqrt x); [now apply sqrt_pos|].
  now apply Rmult_le_compat. }
(* Goal: False *)
destruct (Req_dec a 0) as [Za|Nza].
- (* a = 0 *)
(* Goal: False *)
  apply (Rlt_irrefl 0).
  apply Rlt_le_trans with (b * b); [now apply Rmult_lt_0_compat|].
(* Goal: Rle (Rmult b b) (IZR Z0) *)
  apply Rle_trans with x.
  + revert Hsl; unfold Rminus; rewrite Za; do 3 rewrite Rmult_0_r.
(* Goal: forall _ : Rle (Rplus (Rplus (Rplus (IZR Z0) (IZR Z0)) (Ropp (IZR Z0))) (Rmult b b)) x, Rle (Rmult b b) x *)
    now rewrite Ropp_0; do 3 rewrite Rplus_0_l.
  + rewrite Fx.
    apply (Rmult_le_reg_r (bpow (- fexp1 (ln_beta x))));
      [now apply bpow_gt_0|].
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    rewrite Rmult_0_l; bpow_simplify.
(* Goal: Rle (Z2R mx) (IZR Z0) *)
    unfold mx.
    rewrite Ztrunc_floor;
      [|now apply Rmult_le_pos; [apply Rlt_le|apply bpow_ge_0]].
(* Goal: Rle (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (IZR Z0) *)
    apply Req_le.
(* Goal: @eq R (Z2R (Zceil (Rmult (Rminus x y) (Fcore_Raux.bpow beta (Z.opp (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Z2R mx) *)
    change 0 with (Z2R 0); apply f_equal.
(* Goal: @eq Z (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) Z0 *)
    apply Zfloor_imp.
(* Goal: and (Rle (Z2R Z0) (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Rlt (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Z2R (Z.add Z0 (Zpos xH)))) *)
    split; [now apply Rmult_le_pos; [apply Rlt_le|apply bpow_ge_0]|simpl].
(* Goal: Rlt (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (IZR (Zpos xH)) *)
    apply (Rmult_lt_reg_r (bpow (fexp1 (ln_beta x)))); [now apply bpow_gt_0|].
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    rewrite Rmult_1_l; bpow_simplify.
    apply Rlt_le_trans with (bpow (2 * fexp1 (ln_beta (sqrt x))));
      [|now apply bpow_le].
    change 2%Z with (1 + 1)%Z; rewrite Zmult_plus_distr_l; rewrite Zmult_1_l.
(* Goal: Rlt x (Fcore_Raux.bpow beta (Z.add (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))))) *)
    rewrite bpow_plus.
    rewrite <- (sqrt_def x) at 1; [|now apply Rlt_le].
    assert (sqrt x < bpow (fexp1 (ln_beta (sqrt x))));
      [|now apply Rmult_lt_compat; [apply sqrt_pos|apply sqrt_pos| |]].
(* Goal: Rlt (sqrt x) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))))) *)
    apply (Rle_lt_trans _ _ _ Hr); rewrite Za; rewrite Rplus_0_l.
(* Goal: Rlt b' (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))))) *)
    unfold b'; change (bpow _) with u1.
    apply Rlt_le_trans with (/ 2 * (u1 + u1)); [|lra].
(* Goal: Rlt (Rplus a (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta a (Fcore_Raux.ln_beta beta a)))))) (Rplus a (ulp beta fexp1 a)) *)
    apply Rmult_lt_compat_l; [lra|]; apply Rplus_lt_compat_l.
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
    unfold u2, u1, ulp, canonic_exp; apply bpow_lt; omega.
- (* a <> 0 *)
(* Goal: False *)
  assert (Pa : 0 < a); [lra|].
(* Goal: False *)
  assert (Hla : (ln_beta a = ln_beta (sqrt x) :> Z)).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
  { unfold a; apply ln_beta_DN.
(* Goal: Valid_exp fexp1 *)
    - exact Vfexp1.
    - now fold a. }
  assert (Hl' : 0 < - (u2 * a) + b * b).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
  { apply (Rplus_lt_reg_r (u2 * a)); ring_simplify.
(* Goal: Rlt (Rplus (Rminus (round beta fexp1 Zceil (Rminus x y)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y)))) (Rminus (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y))) (Rminus x y))) (Rplus (Rminus x y) (Rminus (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y))) (Rminus x y))) *)
    unfold b; ring_simplify.
    apply (Rplus_lt_reg_r (/ 2 * u2 * u1)); field_simplify.
    replace (_ / 2) with (u2 * (a + / 2 * u1)) by field.
    replace (_ / 8) with (/ 4 * (u2 ^ 2 + u1 ^ 2)) by field.
    apply Rlt_le_trans with (u2 * bpow (ln_beta (sqrt x))).
    - apply Rmult_lt_compat_l; [now unfold u2, ulp; apply bpow_gt_0|].
      unfold u1; rewrite <- Hla.
      apply Rlt_le_trans with (a + ulp beta fexp1 a).
      + apply Rplus_lt_compat_l.
        rewrite <- (Rmult_1_l (ulp _ _ _)).
(* Goal: Rlt (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta a (Fcore_Raux.ln_beta beta a))))) (Rmult (IZR (Zpos xH)) (ulp beta fexp1 a)) *)
        rewrite ulp_neq_0; trivial.
(* Goal: Rlt (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta a (Fcore_Raux.ln_beta beta a))))) (Rmult (IZR (Zpos xH)) (Fcore_Raux.bpow beta (canonic_exp beta fexp1 a))) *)
        apply Rmult_lt_compat_r; [apply bpow_gt_0|lra].
      + apply (id_p_ulp_le_bpow _ _ _ _ Pa Fa).
(* Goal: Rlt a (Fcore_Raux.bpow beta (ln_beta_val beta a (Fcore_Raux.ln_beta beta a))) *)
        apply Rabs_lt_inv, bpow_ln_beta_gt.
    - apply Rle_trans with (bpow (- 1) * u1 ^ 2).
      + unfold pow; rewrite Rmult_1_r.
(* Goal: Rle (Fcore_Raux.bpow beta (Z.add (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))) (fexp2 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))))) (Fcore_Raux.bpow beta (Z.sub (Z.mul (Zpos (xO xH)) (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))))) (Zpos xH))) *)
        unfold u1, u2, ulp, canonic_exp; bpow_simplify; apply bpow_le.
(* Goal: Z.le (Z.add (fexp2 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (Z.sub (Z.mul (Zpos (xO xH)) (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))))) (Zpos xH)) *)
        now apply Hexp.
      + apply Rmult_le_compat.
        * apply bpow_ge_0.
        * apply pow2_ge_0.
        * unfold Fcore_Raux.bpow, Z.pow_pos; simpl; rewrite Zmult_1_r.
(* Goal: Rle (Rinv (Z2R (radix_val beta))) (Rinv (IZR (Zpos (xO xH)))) *)
          apply Rinv_le; [lra|].
(* Goal: Rle (Z2R (Zceil (Rmult (Rminus x y) (Fcore_Raux.bpow beta (Z.opp (fexp (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH)))))))) (Z2R (Z.pow (radix_val beta) (Z.sub (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (fexp (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH)))) (Zpos xH)))) *)
          now change 4 with (Z2R 4); apply Z2R_le.
        * rewrite <- (Rplus_0_l (u1 ^ 2)) at 1; apply Rplus_le_compat_r.
          apply pow2_ge_0. }
  assert (Hr' : x <= a * a + u1 * a).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
  { rewrite Hla in Fa.
    rewrite <- Rmult_plus_distr_r.
(* Goal: Rle x (Rmult (Rplus a u1) a) *)
    unfold u1, ulp, canonic_exp.
    rewrite <- (Rmult_1_l (bpow _)); rewrite Fa; rewrite <- Rmult_plus_distr_r.
    rewrite <- Rmult_assoc; rewrite (Rmult_comm _ (Z2R ma)).
    rewrite <- (Rmult_assoc (Z2R ma)); bpow_simplify.
    apply (Rmult_le_reg_r (bpow (- 2 * fexp1 (ln_beta (sqrt x)))));
      [now apply bpow_gt_0|bpow_simplify].
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    rewrite Fx at 1; bpow_simplify.
    rewrite <- Z2R_Zpower; [|omega].
    change 1 with (Z2R 1); rewrite <- Z2R_plus; do 2 rewrite <- Z2R_mult.
(* Goal: Rle (Z2R (Z.mul mx (Z.pow (radix_val beta) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Z.mul (Zpos (xO xH)) (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))))))))) (Z2R (Z.mul ma (Z.add ma (Zpos xH)))) *)
    apply Z2R_le, Zlt_succ_le, lt_Z2R.
(* Goal: Rlt (Z2R (Z.mul (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Z.pow (radix_val beta) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Z2R (Z.add (Z.mul (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Z.pow (radix_val beta) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Zpos xH))) *)
    unfold Z.succ; rewrite Z2R_plus; do 2 rewrite Z2R_mult; rewrite Z2R_plus.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Z2R (Z.pow (radix_val beta) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    rewrite Z2R_Zpower; [|omega].
    apply (Rmult_lt_reg_r (bpow (2 * fexp1 (ln_beta (sqrt x)))));
      [now apply bpow_gt_0|bpow_simplify].
    rewrite <- Fx.
    change 2%Z with (1 + 1)%Z; rewrite Zmult_plus_distr_l; rewrite Zmult_1_l.
(* Goal: Rlt x (Rmult (Rplus (Rmult (Z2R ma) (Rplus (Z2R ma) (Z2R (Zpos xH)))) (Z2R (Zpos xH))) (Fcore_Raux.bpow beta (Z.add (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))))))) *)
    rewrite bpow_plus; simpl.
    replace (_ * _) with (a * a + u1 * a + u1 * u1);
      [|unfold u1, ulp, canonic_exp; rewrite Fa; ring].
(* Goal: Rlt x (Rplus (Rplus (Rmult a a) (Rmult u1 a)) (Rmult u1 u1)) *)
    apply (Rle_lt_trans _ _ _ Hsr).
(* Goal: Rlt (Rplus a (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta a (Fcore_Raux.ln_beta beta a)))))) (Rplus a (ulp beta fexp1 a)) *)
    rewrite Rplus_assoc; apply Rplus_lt_compat_l.
    apply (Rplus_lt_reg_r (- b' * b' + / 2 * u1 * u2)); ring_simplify.
    replace (_ + _) with ((a + / 2 * u1) * u2) by ring.
    apply Rlt_le_trans with (bpow (ln_beta (sqrt x)) * u2).
    - apply Rmult_lt_compat_r; [now unfold u2, ulp; apply bpow_gt_0|].
      apply Rlt_le_trans with (a + u1); [lra|].
(* Goal: Rle (Rplus a u1) (Fcore_Raux.bpow beta (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) *)
      unfold u1; fold (canonic_exp beta fexp1 (sqrt x)).
      rewrite <- canonic_exp_DN; [|exact Vfexp1|exact Pa]; fold a.
      rewrite <- ulp_neq_0; trivial.
(* Goal: Rle (Rplus a (ulp beta fexp1 a)) (Fcore_Raux.bpow beta (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) *)
      apply id_p_ulp_le_bpow.
      + exact Pa.
(* Goal: Rle (IZR Z0) rd *)
      + now apply round_DN_pt.
      + apply Rle_lt_trans with (sqrt x).
(* Goal: Rle (IZR Z0) rd *)
        * now apply round_DN_pt.
        * apply Rabs_lt_inv.
(* Goal: Rlt (Rabs (sqrt x)) (Fcore_Raux.bpow beta (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) *)
          apply bpow_ln_beta_gt.
    - apply Rle_trans with (/ 2 * u1 ^ 2).
      + apply Rle_trans with (bpow (- 1) * u1 ^ 2).
        * unfold pow; rewrite Rmult_1_r.
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) u2) (Rmult (Fcore_Raux.bpow beta (Zneg xH)) (Rmult u1 u1)) *)
          unfold u2, u1, ulp, canonic_exp.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
          bpow_simplify.
(* Goal: Rle (Fcore_Raux.bpow beta (Z.add (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))) (fexp2 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))))) (Fcore_Raux.bpow beta (Z.sub (Z.mul (Zpos (xO xH)) (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))))) (Zpos xH))) *)
          apply bpow_le.
(* Goal: Z.le (Z.add (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))) (fexp2 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))))) (Z.sub (Z.mul (Zpos (xO xH)) (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))))) (Zpos xH)) *)
          rewrite Zplus_comm.
(* Goal: Z.le (Z.add (fexp2 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (Z.sub (Z.mul (Zpos (xO xH)) (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))))) (Zpos xH)) *)
          now apply Hexp.
        * apply Rmult_le_compat_r; [now apply pow2_ge_0|].
(* Goal: Rle (Fcore_Raux.bpow beta (Zneg xH)) (Rinv (IZR (Zpos (xO xH)))) *)
          unfold Fcore_Raux.bpow; simpl; unfold Z.pow_pos; simpl.
(* Goal: @eq R (Rplus (Rmult (Z2R (Zfloor (scaled_mantissa beta fexp2 rd))) (Fcore_Raux.bpow beta (canonic_exp beta fexp2 x))) (Rmult (Rmult (Z2R n) (Rinv (Z2R (Z.mul (radix_val beta) (Zpos xH))))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) x *)
          rewrite Zmult_1_r.
(* Goal: Rle (Rinv (Z2R (radix_val beta))) (Rinv (IZR (Zpos (xO xH)))) *)
          apply Rinv_le; [lra|].
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
          change 2 with (Z2R 2); apply Z2R_le; omega.
      + assert (u2 ^ 2 < u1 ^ 2); [|unfold b'; lra].
(* Goal: Rlt (pow u2 (S (S O))) (pow u1 (S (S O))) *)
        unfold pow; do 2 rewrite Rmult_1_r.
(* Goal: Rlt (Rmult u2 u2) (Rmult u1 u1) *)
        assert (H' : 0 <= u2); [unfold u2, ulp; apply bpow_ge_0|].
(* Goal: Rlt (Rmult u2 u2) (Rmult u1 u1) *)
        assert (u2 < u1); [|now apply Rmult_lt_compat].
        unfold u1, u2, ulp, canonic_exp; apply bpow_lt; omega. }
  apply (Rlt_irrefl (a * a + u1 * a)).
  apply Rlt_le_trans with (a * a + u1 * a - u2 * a + b * b).
  + rewrite <- (Rplus_0_r (a * a + _)) at 1.
    unfold Rminus; rewrite (Rplus_assoc _ _ (b * b)).
(* Goal: Rlt (Rplus a (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta a (Fcore_Raux.ln_beta beta a)))))) (Rplus a (ulp beta fexp1 a)) *)
    now apply Rplus_lt_compat_l.
  + now apply Rle_trans with x.
Qed.

Lemma double_round_sqrt_beta_ge_4 :
  (4 <= beta)%Z ->
  forall fexp1 fexp2 : Z -> Z,
  Valid_exp fexp1 -> Valid_exp fexp2 ->
  forall (choice1 choice2 : Z -> bool),
  double_round_sqrt_beta_ge_4_hyp fexp1 fexp2 ->
  forall x,
  generic_format beta fexp1 x ->
  double_round_eq fexp1 fexp2 choice1 choice2 (sqrt x).
Proof.
(* Goal: forall (_ : Z.le (Zpos (xO (xO xH))) (radix_val beta)) (fexp1 fexp2 : forall _ : Z, Z) (_ : Valid_exp fexp1) (_ : Valid_exp fexp2) (choice1 choice2 : forall _ : Z, bool) (_ : double_round_sqrt_beta_ge_4_hyp fexp1 fexp2) (x : R) (_ : generic_format beta fexp1 x), double_round_eq fexp1 fexp2 choice1 choice2 (sqrt x) *)
intros Hbeta fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x Fx.
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
unfold double_round_eq.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (sqrt x))) (round beta fexp1 (Znearest choice1) (sqrt x)) *)
destruct (Rle_or_lt x 0) as [Npx|Px].
- (* x <= 0 *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (sqrt x))) (round beta fexp1 (Znearest choice1) (sqrt x)) *)
  assert (Hs : sqrt x = 0).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
  { destruct (Req_dec x 0) as [Zx|Nzx].
    - (* x = 0 *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rdiv x y))) (round beta fexp1 (Znearest choice1) (Rdiv x y)) *)
      rewrite Zx.
(* Goal: @eq R (sqrt (IZR Z0)) (IZR Z0) *)
      exact sqrt_0.
    - (* x < 0 *)
(* Goal: @eq R (sqrt x) (IZR Z0) *)
      unfold sqrt.
(* Goal: @eq R match Rcase_abs x with | left r => IZR Z0 | right a => Rsqrt (mknonnegreal x (Rge_le x (IZR Z0) a)) end (IZR Z0) *)
      destruct Rcase_abs.
      + reflexivity.
      + casetype False; lra. }
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (sqrt x))) (round beta fexp1 (Znearest choice1) (sqrt x)) *)
  rewrite Hs.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (IZR Z0))) (round beta fexp1 (Znearest choice1) (IZR Z0)) *)
  rewrite round_0.
  + reflexivity.
  + now apply valid_rnd_N.
- (* 0 < x *)
  assert (Hfx : (fexp1 (ln_beta x) < ln_beta x)%Z);
    [now apply ln_beta_generic_gt; try assumption; lra|].
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (sqrt x))) (round beta fexp1 (Znearest choice1) (sqrt x)) *)
  assert (Hfsx : (fexp1 (ln_beta (sqrt x)) < ln_beta (sqrt x))%Z).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
  { destruct (Rle_or_lt x 1) as [Hx|Hx].
    - (* x <= 1 *)
(* Goal: Z.lt (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))) *)
      apply (valid_exp_large fexp1 (ln_beta x)); [exact Hfx|].
(* Goal: Z.le (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))) *)
      apply ln_beta_le; [exact Px|].
      rewrite <- (sqrt_def x) at 1; [|lra].
      rewrite <- Rmult_1_r.
(* Goal: Rle (Rmult (sqrt x) (sqrt x)) (Rmult (sqrt x) (IZR (Zpos xH))) *)
      apply Rmult_le_compat_l.
      + apply sqrt_pos.
      + rewrite <- sqrt_1.
(* Goal: Rle (sqrt x) (sqrt (IZR (Zpos xH))) *)
        now apply sqrt_le_1_alt.
    - (* 1 < x *)
(* Goal: Z.lt (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))) *)
      generalize ((proj1 (proj2 Hexp)) 1%Z).
      replace (_ - 1)%Z with 1%Z by ring.
(* Goal: forall _ : Z.le (Z.mul (Zpos (xO xH)) (fexp1 (Zpos xH))) (fexp1 (Zpos xH)), Z.lt (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))) *)
      intro Hexp10.
(* Goal: Z.lt (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))) *)
      assert (Hf0 : (fexp1 1 < 1)%Z); [omega|clear Hexp10].
(* Goal: Z.lt (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))) *)
      apply (valid_exp_large fexp1 1); [exact Hf0|].
(* Goal: Z.le (Zpos xH) (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x))) *)
      apply ln_beta_ge_bpow.
(* Goal: Rle (Fcore_Raux.bpow beta (Z.sub (Zpos xH) (Zpos xH))) (Rabs (sqrt x)) *)
      rewrite Zeq_minus; [|reflexivity].
(* Goal: Rle (Fcore_Raux.bpow beta Z0) (Rabs (sqrt x)) *)
      unfold Fcore_Raux.bpow; simpl.
(* Goal: Rle (IZR (Zpos xH)) (Rabs (sqrt x)) *)
      apply Rabs_ge; right.
      rewrite <- sqrt_1.
(* Goal: Rle (sqrt (IZR (Zpos xH))) (sqrt x) *)
      apply sqrt_le_1_alt.
      now apply Rlt_le. }
  assert (Hf2 : (fexp2 (ln_beta (sqrt x)) <= fexp1 (ln_beta (sqrt x)) - 1)%Z).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
  { assert (H : (fexp1 (2 * ln_beta (sqrt x)) < 2 * ln_beta (sqrt x))%Z).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
    { destruct (ln_beta_sqrt_disj x Px) as [Hlx|Hlx].
      - apply (valid_exp_large fexp1 (ln_beta x)); [|omega].
(* Goal: Z.lt (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) *)
        now apply ln_beta_generic_gt; [|apply Rgt_not_eq|].
      - rewrite <- Hlx.
        now apply ln_beta_generic_gt; [|apply Rgt_not_eq|]. }
(* Goal: Z.le (fexp2 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (Z.sub (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (Zpos xH)) *)
    generalize ((proj2 (proj2 Hexp)) (ln_beta (sqrt x)) H).
    omega. }
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (sqrt x))) (round beta fexp1 (Znearest choice1) (sqrt x)) *)
  apply double_round_mid_cases.
(* Goal: Valid_exp fexp1 *)
  + exact Vfexp1.
  + exact Vfexp2.
  + now apply sqrt_lt_R0.
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  + omega.
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  + omega.
  + intros Hmid; casetype False; apply (Rle_not_lt _ _ Hmid).
    apply (double_round_sqrt_beta_ge_4_aux Hbeta fexp1 fexp2 Vfexp1 Vfexp2
                                           Hexp x Px Hf2 Fx).
Qed.

Section Double_round_sqrt_beta_ge_4_FLX.

Import Fcore_FLX.

Variable prec : Z.
Variable prec' : Z.

(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
Context { prec_gt_0_ : Prec_gt_0 prec }.
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
Context { prec_gt_0_' : Prec_gt_0 prec' }.

Lemma FLX_double_round_sqrt_beta_ge_4_hyp :
  (2 * prec + 1 <= prec')%Z ->
  double_round_sqrt_beta_ge_4_hyp (FLX_exp prec) (FLX_exp prec').
Proof.
(* Goal: forall _ : Z.le (Z.mul (Zpos (xO xH)) prec) prec', double_round_div_hyp (FLX_exp prec) (FLX_exp prec') *)
intros Hprec.
(* Goal: double_round_div_hyp (FLX_exp prec) (FLX_exp prec') *)
unfold FLX_exp.
(* Goal: double_round_div_hyp (fun e : Z => if Z.ltb (Z.sub e prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub e prec) (fun e : Z => if Z.ltb (Z.sub e prec') emin' then Z.sub (Z.add emin' prec') (Zpos xH) else Z.sub e prec') *)
unfold Prec_gt_0 in prec_gt_0_.
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
unfold double_round_sqrt_beta_ge_4_hyp; split; [|split]; intro ex; omega.
Qed.

Theorem double_round_sqrt_beta_ge_4_FLX :
  (4 <= beta)%Z ->
  forall choice1 choice2,
  (2 * prec + 1 <= prec')%Z ->
  forall x,
  FLX_format beta prec x ->
  double_round_eq (FLX_exp prec) (FLX_exp prec') choice1 choice2 (sqrt x).
Proof.
(* Goal: forall (_ : Z.le (Zpos (xO (xO xH))) (radix_val beta)) (choice1 choice2 : forall _ : Z, bool) (_ : Z.le (Z.add (Z.mul (Zpos (xO xH)) prec) (Zpos xH)) prec') (x : R) (_ : FLX_format beta prec x), double_round_eq (FLX_exp prec) (FLX_exp prec') choice1 choice2 (sqrt x) *)
intros Hbeta choice1 choice2 Hprec x Fx.
(* Goal: double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec') choice1 choice2 (sqrt x) *)
apply double_round_sqrt_beta_ge_4.
- exact Hbeta.
- now apply FLX_exp_valid.
- now apply FLX_exp_valid.
- now apply FLX_double_round_sqrt_beta_ge_4_hyp.
- now apply generic_format_FLX.
Qed.

End Double_round_sqrt_beta_ge_4_FLX.

Section Double_round_sqrt_beta_ge_4_FLT.

Import Fcore_FLX.
Import Fcore_FLT.

Variable emin prec : Z.
Variable emin' prec' : Z.

(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
Context { prec_gt_0_ : Prec_gt_0 prec }.
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
Context { prec_gt_0_' : Prec_gt_0 prec' }.

Lemma FLT_double_round_sqrt_beta_ge_4_hyp :
  (emin <= 0)%Z ->
  ((emin' <= emin - prec - 1)%Z
   \/ (2 * emin' <= emin - 4 * prec)%Z) ->
  (2 * prec + 1 <= prec')%Z ->
  double_round_sqrt_beta_ge_4_hyp (FLT_exp emin prec) (FLT_exp emin' prec').
Proof.
(* Goal: forall (_ : Z.le emin Z0) (_ : or (Z.le emin' (Z.sub (Z.sub emin prec) (Zpos xH))) (Z.le (Z.mul (Zpos (xO xH)) emin') (Z.sub emin (Z.mul (Zpos (xO (xO xH))) prec)))) (_ : Z.le (Z.add (Z.mul (Zpos (xO xH)) prec) (Zpos xH)) prec'), double_round_sqrt_beta_ge_4_hyp (FLT_exp emin prec) (FLT_exp emin' prec') *)
intros Hemin Heminprec Hprec.
(* Goal: double_round_div_hyp (FLT_exp emin prec) (FLT_exp emin' prec') *)
unfold FLT_exp.
(* Goal: double_round_div_hyp (fun e : Z => if Z.ltb (Z.sub e prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub e prec) (fun e : Z => if Z.ltb (Z.sub e prec') emin' then Z.sub (Z.add emin' prec') (Zpos xH) else Z.sub e prec') *)
unfold Prec_gt_0 in prec_gt_0_.
(* Goal: double_round_sqrt_beta_ge_4_hyp (fun e : Z => if Z.ltb (Z.sub e prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub e prec) (fun e : Z => if Z.ltb (Z.sub e prec') emin' then Z.sub (Z.add emin' prec') (Zpos xH) else Z.sub e prec') *)
unfold double_round_sqrt_beta_ge_4_hyp; split; [|split]; intros ex.
- generalize (Zmax_spec (ex - prec) emin).
  generalize (Zmax_spec (2 * ex - prec) emin).
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  omega.
- generalize (Zmax_spec (ex - prec) emin).
  generalize (Zmax_spec (2 * ex - 1 - prec) emin).
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  omega.
- generalize (Zmax_spec (2 * ex - prec) emin).
  generalize (Zmax_spec (ex - prec') emin').
  generalize (Zmax_spec (ex - prec) emin).
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  omega.
Qed.

Theorem double_round_sqrt_beta_ge_4_FLT :
  (4 <= beta)%Z ->
  forall choice1 choice2,
  (emin <= 0)%Z ->
  ((emin' <= emin - prec - 1)%Z
   \/ (2 * emin' <= emin - 4 * prec)%Z) ->
  (2 * prec + 1 <= prec')%Z ->
  forall x,
  FLT_format beta emin prec x ->
  double_round_eq (FLT_exp emin prec) (FLT_exp emin' prec')
                  choice1 choice2 (sqrt x).
Proof.
(* Goal: forall (_ : Z.le (Zpos (xO (xO xH))) (radix_val beta)) (choice1 choice2 : forall _ : Z, bool) (_ : Z.le emin Z0) (_ : or (Z.le emin' (Z.sub (Z.sub emin prec) (Zpos xH))) (Z.le (Z.mul (Zpos (xO xH)) emin') (Z.sub emin (Z.mul (Zpos (xO (xO xH))) prec)))) (_ : Z.le (Z.add (Z.mul (Zpos (xO xH)) prec) (Zpos xH)) prec') (x : R) (_ : FLT_format beta emin prec x), double_round_eq (FLT_exp emin prec) (FLT_exp emin' prec') choice1 choice2 (sqrt x) *)
intros Hbeta choice1 choice2 Hemin Heminprec Hprec x Fx.
(* Goal: double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec') choice1 choice2 (sqrt x) *)
apply double_round_sqrt_beta_ge_4.
- exact Hbeta.
- now apply FLT_exp_valid.
- now apply FLT_exp_valid.
- now apply FLT_double_round_sqrt_beta_ge_4_hyp.
- now apply generic_format_FLT.
Qed.

End Double_round_sqrt_beta_ge_4_FLT.

Section Double_round_sqrt_beta_ge_4_FTZ.

Import Fcore_FLX.
Import Fcore_FTZ.

Variable emin prec : Z.
Variable emin' prec' : Z.

(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
Context { prec_gt_0_ : Prec_gt_0 prec }.
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
Context { prec_gt_0_' : Prec_gt_0 prec' }.

Lemma FTZ_double_round_sqrt_beta_ge_4_hyp :
  (2 * (emin' + prec') <= emin + prec <= 1)%Z ->
  (2 * prec + 1 <= prec')%Z ->
  double_round_sqrt_beta_ge_4_hyp (FTZ_exp emin prec) (FTZ_exp emin' prec').
Proof.
(* Goal: forall (_ : Z.le (Z.add emin' prec') (Z.sub emin (Zpos xH))) (_ : Z.le (Z.mul (Zpos (xO xH)) prec) prec'), double_round_div_hyp (FTZ_exp emin prec) (FTZ_exp emin' prec') *)
intros Hemin Hprec.
(* Goal: double_round_div_hyp (FTZ_exp emin prec) (FTZ_exp emin' prec') *)
unfold FTZ_exp.
unfold Prec_gt_0 in *.
(* Goal: double_round_sqrt_beta_ge_4_hyp (fun e : Z => if Z.ltb (Z.sub e prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub e prec) (fun e : Z => if Z.ltb (Z.sub e prec') emin' then Z.sub (Z.add emin' prec') (Zpos xH) else Z.sub e prec') *)
unfold double_round_sqrt_beta_ge_4_hyp; split; [|split]; intros ex.
- destruct (Z.ltb_spec (ex - prec) emin);
  destruct (Z.ltb_spec (2 * ex - prec) emin);
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  omega.
- destruct (Z.ltb_spec (ex - prec) emin);
  destruct (Z.ltb_spec (2 * ex - 1 - prec) emin);
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  omega.
- intro H.
  destruct (Zle_or_lt emin (2 * ex - prec)) as [H'|H'].
  + destruct (Z.ltb_spec (ex - prec') emin');
    destruct (Z.ltb_spec (ex - prec) emin);
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
    omega.
  + casetype False.
(* Goal: False *)
    rewrite (Zlt_bool_true _ _ H') in H.
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
    omega.
Qed.

Theorem double_round_sqrt_beta_ge_4_FTZ :
  (4 <= beta)%Z ->
  forall choice1 choice2,
  (2 * (emin' + prec') <= emin + prec <= 1)%Z ->
  (2 * prec + 1 <= prec')%Z ->
  forall x,
  FTZ_format beta emin prec x ->
  double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec')
                  choice1 choice2 (sqrt x).
Proof.
(* Goal: forall (_ : Z.le (Zpos (xO (xO xH))) (radix_val beta)) (choice1 choice2 : forall _ : Z, bool) (_ : and (Z.le (Z.mul (Zpos (xO xH)) (Z.add emin' prec')) (Z.add emin prec)) (Z.le (Z.add emin prec) (Zpos xH))) (_ : Z.le (Z.add (Z.mul (Zpos (xO xH)) prec) (Zpos xH)) prec') (x : R) (_ : FTZ_format beta emin prec x), double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec') choice1 choice2 (sqrt x) *)
intros Hbeta choice1 choice2 Hemin Hprec x Fx.
(* Goal: double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec') choice1 choice2 (sqrt x) *)
apply double_round_sqrt_beta_ge_4.
- exact Hbeta.
- now apply FTZ_exp_valid.
- now apply FTZ_exp_valid.
- now apply FTZ_double_round_sqrt_beta_ge_4_hyp.
- now apply generic_format_FTZ.
Qed.

End Double_round_sqrt_beta_ge_4_FTZ.

End Double_round_sqrt_beta_ge_4.

End Double_round_sqrt.

Section Double_round_div.

Lemma double_round_eq_mid_beta_even :
  forall (fexp1 fexp2 : Z -> Z),
  Valid_exp fexp1 -> Valid_exp fexp2 ->
  forall (choice1 choice2 : Z -> bool),
  (exists n, (beta = 2 * n :> Z)%Z) ->
  forall x,
  0 < x ->
  (fexp2 (ln_beta x) <= fexp1 (ln_beta x) - 1)%Z ->
  (fexp1 (ln_beta x) <= ln_beta x)%Z ->
  x = midp fexp1 x ->
  double_round_eq fexp1 fexp2 choice1 choice2 x.
Proof.
(* Goal: forall (fexp1 fexp2 : forall _ : Z, Z) (_ : Valid_exp fexp1) (_ : Valid_exp fexp2) (choice1 choice2 : forall _ : Z, bool) (_ : @ex Z (fun n : Z => @eq Z (radix_val beta) (Z.mul (Zpos (xO xH)) n))) (x : R) (_ : Rlt (IZR Z0) x) (_ : Z.le (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Zpos xH))) (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : @eq R x (midp fexp1 x)), double_round_eq fexp1 fexp2 choice1 choice2 x *)
intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Ebeta x Px Hf2 Hf1.
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
unfold double_round_eq.
(* Goal: forall _ : @eq R x (midp fexp1 x), @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)) (round beta fexp1 (Znearest choice1) x) *)
unfold midp.
(* Goal: forall _ : @eq R x (Rplus (round beta fexp1 Zfloor x) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 x))), @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)) (round beta fexp1 (Znearest choice1) x) *)
set (rd := round beta fexp1 Zfloor x).
(* Goal: forall _ : @eq R x (Rplus rd (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 x))), @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)) (round beta fexp1 (Znearest choice1) x) *)
set (u := ulp beta fexp1 x).
intro H; apply (Rplus_eq_compat_l (- rd)) in H.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)) (round beta fexp1 (Znearest choice1) x) *)
ring_simplify in H; revert H.
(* Goal: forall _ : @eq R (Rplus (Ropp rd) x) (Rmult (Rinv (IZR (Zpos (xO xH)))) u), @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)) (round beta fexp1 (Znearest choice1) x) *)
rewrite Rplus_comm; fold (Rminus x rd).
(* Goal: forall _ : @eq R (Rminus x rd) (Rmult (Rinv (IZR (Zpos (xO xH)))) u), @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)) (round beta fexp1 (Znearest choice1) x) *)
intro Xmid.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)) (round beta fexp1 (Znearest choice1) x) *)
destruct Ebeta as (n,Ebeta).
(* Goal: Rlt (Rinv (Z2R (Z.mul (radix_val beta) (radix_val beta)))) (Rinv (IZR (Zpos (xO xH)))) *)
assert (Hbeta : (2 <= beta)%Z).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ destruct beta as (beta_val,beta_prop).
  now apply Zle_bool_imp_le. }
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)) (round beta fexp1 (Znearest choice1) x) *)
apply (Rplus_eq_compat_l rd) in Xmid; ring_simplify in Xmid.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)) (round beta fexp1 (Znearest choice1) x) *)
rewrite (round_generic beta fexp2); [reflexivity|now apply valid_rnd_N|].
set (f := Float beta (Zfloor (scaled_mantissa beta fexp2 rd)
                      + n * beta ^ (fexp1 (ln_beta x) - 1
                                    - fexp2 (ln_beta x)))
                (canonic_exp beta fexp2 x)).
(* Goal: generic_format beta fexp2 x *)
assert (Hf : F2R f = x).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ unfold f, F2R; simpl.
(* Goal: Rlt (Z2R (Z.mul (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Z.pow (radix_val beta) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Z2R (Z.add (Z.mul (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Z.pow (radix_val beta) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Zpos xH))) *)
  rewrite Z2R_plus.
(* Goal: @eq R (Rmult (Rplus (Z2R (Zfloor (scaled_mantissa beta fexp2 rd))) (Z2R (Z.mul n (Z.pow (radix_val beta) (Z.sub (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Zpos xH)) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (canonic_exp beta fexp2 x))) x *)
  rewrite Rmult_plus_distr_r.
(* Goal: @eq R (Rmult (Z2R (Z.mul (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Z.pow (radix_val beta) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
  rewrite Z2R_mult.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Z2R (Z.pow (radix_val beta) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
  rewrite Z2R_Zpower; [|omega].
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
  unfold canonic_exp at 2; bpow_simplify.
(* Goal: Rlt x (Fcore_Raux.bpow beta (Z.add (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))))) *)
  unfold Zminus; rewrite bpow_plus.
  rewrite (Rmult_comm _ (bpow (- 1))).
  rewrite <- (Rmult_assoc (Z2R n)).
  change (bpow (- 1)) with (/ Z2R (beta * 1)).
(* Goal: @eq R (Rplus (Rmult (Z2R (Zfloor (scaled_mantissa beta fexp2 rd))) (Fcore_Raux.bpow beta (canonic_exp beta fexp2 x))) (Rmult (Rmult (Z2R n) (Rinv (Z2R (Z.mul (radix_val beta) (Zpos xH))))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) x *)
  rewrite Zmult_1_r.
(* Goal: @eq R (Rplus (Rmult (Z2R (Zfloor (scaled_mantissa beta fexp2 rd))) (Fcore_Raux.bpow beta (canonic_exp beta fexp2 x))) (Rmult (Rmult (Z2R n) (Rinv (Z2R (radix_val beta)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) x *)
  rewrite Ebeta.
(* Goal: @eq R (Rplus (Rmult (Z2R (Zfloor (scaled_mantissa beta fexp2 rd))) (Fcore_Raux.bpow beta (canonic_exp beta fexp2 x))) (Rmult (Rmult (Z2R n) (Rinv (Z2R (Z.mul (Zpos (xO xH)) n)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) x *)
  rewrite (Z2R_mult 2).
  rewrite Rinv_mult_distr;
    [|simpl; lra|change 0 with (Z2R 0); apply Z2R_neq; omega].
  rewrite <- Rmult_assoc; rewrite (Rmult_comm (Z2R n));
  rewrite (Rmult_assoc _ (Z2R n)).
  rewrite Rinv_r;
    [rewrite Rmult_1_r|change 0 with (Z2R 0); apply Z2R_neq; omega].
(* Goal: generic_format beta fexp1 (Rmult (Z2R (Zceil (scaled_mantissa beta fexp1 x))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
  simpl; fold (canonic_exp beta fexp1 x).
  rewrite <- 2!ulp_neq_0; try now apply Rgt_not_eq.
(* Goal: @eq R (Rplus (Rmult (Z2R (Zfloor (scaled_mantissa beta fexp2 rd))) (ulp beta fexp2 x)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 x))) x *)
  fold u; rewrite Xmid at 2.
(* Goal: @eq R (Rplus (Rmult (Z2R (Zfloor (scaled_mantissa beta fexp2 rd))) (ulp beta fexp2 x)) (Rmult (Rinv (IZR (Zpos (xO xH)))) u)) (Rplus rd (Rmult (Rinv (IZR (Zpos (xO xH)))) u)) *)
  apply f_equal2; [|reflexivity].
(* Goal: not (@eq R x (IZR Z0)) *)
  rewrite ulp_neq_0; try now apply Rgt_not_eq.
(* Goal: @eq R (Rmult (Z2R (Zfloor (scaled_mantissa beta fexp2 rd))) (Fcore_Raux.bpow beta (canonic_exp beta fexp2 x))) rd *)
  destruct (Req_dec rd 0) as [Zrd|Nzrd].
  - (* rd = 0 *)
(* Goal: @eq R (Rmult (Z2R (Zfloor (scaled_mantissa beta fexp2 rd))) (Fcore_Raux.bpow beta (canonic_exp beta fexp2 x))) rd *)
    rewrite Zrd.
(* Goal: @eq R (Rmult (Z2R (Zfloor (scaled_mantissa beta fexp2 (IZR Z0)))) (Fcore_Raux.bpow beta (canonic_exp beta fexp2 x))) (IZR Z0) *)
    rewrite scaled_mantissa_0.
(* Goal: @eq R (Rmult (Z2R (Zfloor (IZR Z0))) (Fcore_Raux.bpow beta (canonic_exp beta fexp2 x))) (IZR Z0) *)
    change 0 with (Z2R 0) at 1; rewrite Zfloor_Z2R.
(* Goal: generic_format beta fexp2 (Rmult (IZR Z0) y) *)
    now rewrite Rmult_0_l.
  - (* rd <> 0 *)
(* Goal: @eq R (Rmult (Z2R (Zfloor (scaled_mantissa beta fexp2 rd))) (Fcore_Raux.bpow beta (canonic_exp beta fexp2 x))) rd *)
    assert (Nnrd : 0 <= rd).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
    { apply round_DN_pt.
(* Goal: Valid_exp fexp1 *)
      - exact Vfexp1.
      - apply generic_format_0.
      - now apply Rlt_le. }
(* Goal: @eq R (Rmult (Z2R (Zfloor (scaled_mantissa beta fexp2 rd))) (Fcore_Raux.bpow beta (canonic_exp beta fexp2 x))) rd *)
    assert (Prd : 0 < rd); [lra|].
(* Goal: @eq R (Rmult (Z2R (Zfloor (scaled_mantissa beta fexp2 rd))) (Fcore_Raux.bpow beta (canonic_exp beta fexp2 x))) rd *)
    assert (Lrd : (ln_beta rd = ln_beta x :> Z)).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
    { apply Zle_antisym.
      - apply ln_beta_le; [exact Prd|].
(* Goal: Rle (IZR Z0) rd *)
        now apply round_DN_pt.
      - apply ln_beta_round_ge.
(* Goal: Valid_exp fexp1 *)
        + exact Vfexp1.
        + now apply valid_rnd_DN.
        + exact Nzrd. }
(* Goal: @eq R (Rmult (Z2R (Zfloor (scaled_mantissa beta fexp2 rd))) (Fcore_Raux.bpow beta (canonic_exp beta fexp2 x))) rd *)
    unfold scaled_mantissa.
(* Goal: @eq R (Rmult (Z2R (Zfloor (Rmult rd (Fcore_Raux.bpow beta (Z.opp (canonic_exp beta fexp2 rd)))))) (Fcore_Raux.bpow beta (canonic_exp beta fexp2 x))) rd *)
    unfold rd at 1.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) (IZR Z0) *)
    unfold round, F2R, scaled_mantissa, canonic_exp; simpl.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    bpow_simplify.
(* Goal: @eq R (Rmult (Z2R (Zfloor (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta rd (Fcore_Raux.ln_beta beta rd)))))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    rewrite Lrd.
    rewrite <- (Z2R_Zpower _ (_ - _)); [|omega].
    rewrite <- Z2R_mult.
    rewrite (Zfloor_imp (Zfloor (x * bpow (- fexp1 (ln_beta x))) *
                         beta ^ (fexp1 (ln_beta x) - fexp2 (ln_beta x)))).
    + rewrite Z2R_mult.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Z2R (Z.pow (radix_val beta) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
      rewrite Z2R_Zpower; [|omega].
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
      bpow_simplify.
(* Goal: @eq R (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
      now unfold rd.
    + split; [now apply Rle_refl|].
(* Goal: Rlt (Z2R (Z.mul (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Z.pow (radix_val beta) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Z2R (Z.add (Z.mul (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Z.pow (radix_val beta) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Zpos xH))) *)
      rewrite Z2R_plus.
      simpl; lra. }
(* Goal: generic_format beta fexp2 x *)
apply (generic_format_F2R' _ _ x f Hf).
(* Goal: forall _ : not (@eq R x (IZR Z0)), Z.le (canonic_exp beta fexp2 x) (@Fexp beta f) *)
intros _.
(* Goal: Z.le (canonic_exp beta fexp2 x) (@Fexp beta f) *)
apply Zle_refl.
Qed.

Lemma double_round_really_zero :
  forall (fexp1 fexp2 : Z -> Z),
  Valid_exp fexp1 -> Valid_exp fexp2 ->
  forall (choice1 choice2 : Z -> bool),
  forall x,
  0 < x ->
  (ln_beta x <= fexp1 (ln_beta x) - 2)%Z ->
  double_round_eq fexp1 fexp2 choice1 choice2 x.
Proof.
(* Goal: forall (fexp1 fexp2 : forall _ : Z, Z) (_ : Valid_exp fexp1) (_ : Valid_exp fexp2) (choice1 choice2 : forall _ : Z, bool) (x : R) (_ : Rlt (IZR Z0) x) (_ : @eq Z (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Z.add (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH))) (_ : Rlt x (Rminus (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x)))), double_round_eq fexp1 fexp2 choice1 choice2 x *)
intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 x Px Hf1.
assert (Hlx : bpow (ln_beta x - 1) <= x < bpow (ln_beta x)).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ destruct (ln_beta x) as (ex,Hex); simpl.
  rewrite <- (Rabs_right x); [|now apply Rle_ge; apply Rlt_le].
(* Goal: and (Rle (Fcore_Raux.bpow beta (Z.sub ex (Zpos xH))) (Rabs x)) (Rlt (Rabs x) (Fcore_Raux.bpow beta ex)) *)
  apply Hex.
  now apply Rgt_not_eq. }
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
unfold double_round_eq.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)) (round beta fexp1 (Znearest choice1) x) *)
rewrite (round_N_really_small_pos beta fexp1 _ x (ln_beta x)); [|exact Hlx|omega].
(* Goal: forall _ : Rlt x (Rminus (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))), @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)) (round beta fexp1 (Znearest choice1) x) *)
set (x'' := round beta fexp2 (Znearest choice2) x).
destruct (Req_dec x'' 0) as [Zx''|Nzx''];
  [now rewrite Zx''; rewrite round_0; [|apply valid_rnd_N]|].
(* Goal: @eq R (round beta fexp1 (Znearest choice1) x'') (IZR Z0) *)
destruct (Zle_or_lt (fexp2 (ln_beta x)) (ln_beta x)).
- (* fexp2 (ln_beta x) <= ln_beta x *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) x'') (IZR Z0) *)
  destruct (Rlt_or_le x'' (bpow (ln_beta x))).
  + (* x'' < bpow (ln_beta x) *)
    rewrite (round_N_really_small_pos beta fexp1 _ _ (ln_beta x));
    [reflexivity|split; [|exact H0]|omega].
(* Goal: Rle (Fcore_Raux.bpow beta (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH))) x'' *)
    apply round_large_pos_ge_pow; [now apply valid_rnd_N| |now apply Hlx].
(* Goal: Rlt (IZR Z0) (round beta fexp2 (Znearest choice2) x) *)
    fold x''; assert (0 <= x''); [|lra]; unfold x''.
    rewrite <- (round_0 beta fexp2 (Znearest choice2)).
(* Goal: Rle (round beta fexp2 (Znearest choice2) (IZR Z0)) x'' *)
    now apply round_le; [|apply valid_rnd_N|apply Rlt_le].
  + (* bpow (ln_beta x) <= x'' *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) x'') (IZR Z0) *)
    assert (Hx'' : x'' = bpow (ln_beta x)).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
    { apply Rle_antisym; [|exact H0].
      rewrite <- (round_generic beta fexp2 (Znearest choice2) (bpow _)).
      - now apply round_le; [|apply valid_rnd_N|apply Rlt_le].
      - now apply generic_format_bpow'. }
(* Goal: @eq R (round beta fexp1 (Znearest choice1) x'') (IZR Z0) *)
    rewrite Hx''.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) (IZR Z0) *)
    unfold round, F2R, scaled_mantissa, canonic_exp; simpl.
(* Goal: @eq R (Rmult (Z2R (Znearest choice1 (Rmult (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Fcore_Raux.ln_beta beta (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))))))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Fcore_Raux.ln_beta beta (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (IZR Z0) *)
    rewrite ln_beta_bpow.
    assert (Hf11 : (fexp1 (ln_beta x + 1) = fexp1 (ln_beta x) :> Z)%Z);
      [apply Vfexp1; omega|].
(* Goal: @eq R (Rmult (Z2R (Znearest choice1 (Rmult (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (Z.add (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH)))))))) (Fcore_Raux.bpow beta (fexp1 (Z.add (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH))))) (IZR Z0) *)
    rewrite Hf11.
    apply (Rmult_eq_reg_r (bpow (- fexp1 (ln_beta x))));
      [|now apply Rgt_not_eq; apply bpow_gt_0].
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    rewrite Rmult_0_l; bpow_simplify.
(* Goal: @eq R (Z2R (Zceil (Rmult (Rminus x y) (Fcore_Raux.bpow beta (Z.opp (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Z2R mx) *)
    change 0 with (Z2R 0); apply f_equal.
(* Goal: @eq Z (Znearest choice1 (Fcore_Raux.bpow beta (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) Z0 *)
    apply Znearest_imp.
(* Goal: Rlt (Rabs (Rminus (Fcore_Raux.bpow beta (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) (Z2R Z0))) (Rinv (IZR (Zpos (xO xH)))) *)
    simpl; unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r.
(* Goal: Rlt (Rabs (Fcore_Raux.bpow beta (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Rinv (IZR (Zpos (xO xH)))) *)
    rewrite Rabs_right; [|now apply Rle_ge; apply bpow_ge_0].
    apply Rle_lt_trans with (bpow (- 2)); [now apply bpow_le; omega|].
(* Goal: @eq R (Rplus (Rmult (Z2R (Zfloor (scaled_mantissa beta fexp2 rd))) (Fcore_Raux.bpow beta (canonic_exp beta fexp2 x))) (Rmult (Rmult (Z2R n) (Rinv (Z2R (Z.mul (radix_val beta) (Zpos xH))))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) x *)
    unfold Fcore_Raux.bpow, Z.pow_pos; simpl; rewrite Zmult_1_r.
(* Goal: Rlt (Rinv (Z2R (Z.mul (radix_val beta) (radix_val beta)))) (Rinv (IZR (Zpos (xO xH)))) *)
    assert (Hbeta : (2 <= beta)%Z).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
    { destruct beta as (beta_val,beta_prop); simpl.
      now apply Zle_bool_imp_le. }
(* Goal: Rlt (Rinv (Z2R (Z.mul (radix_val beta) (radix_val beta)))) (Rinv (IZR (Zpos (xO xH)))) *)
    apply Rinv_lt_contravar.
    * apply Rmult_lt_0_compat; [lra|].
      rewrite Z2R_mult; apply Rmult_lt_0_compat; change 0 with (Z2R 0);
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
      apply Z2R_lt; omega.
    * change 2 with (Z2R 2); apply Z2R_lt.
(* Goal: Z.lt (Zpos (xO xH)) (Z.mul (radix_val beta) (radix_val beta)) *)
      apply (Zle_lt_trans _ _ _ Hbeta).
      rewrite <- (Zmult_1_r beta) at 1.
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
      apply Zmult_lt_compat_l; omega.
- (* ln_beta x < fexp2 (ln_beta x) *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) x'') (IZR Z0) *)
  casetype False; apply Nzx''.
(* Goal: @eq R x'' (IZR Z0) *)
  now apply (round_N_really_small_pos beta _ _ _ (ln_beta x)).
Qed.

Lemma double_round_zero :
  forall fexp1 fexp2 : Z -> Z,
  Valid_exp fexp1 -> Valid_exp fexp2 ->
  forall (choice1 choice2 : Z -> bool),
  forall x,
  0 < x ->
  (fexp1 (ln_beta x) = ln_beta x + 1 :> Z)%Z ->
  x < bpow (ln_beta x) - / 2 * ulp beta fexp2 x ->
  double_round_eq fexp1 fexp2 choice1 choice2 x.
Proof.
(* Goal: forall (fexp1 fexp2 : forall _ : Z, Z) (_ : Valid_exp fexp1) (_ : Valid_exp fexp2) (choice1 choice2 : forall _ : Z, bool) (x : R) (_ : Rlt (IZR Z0) x) (_ : @eq Z (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Z.add (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH))) (_ : Rlt x (Rminus (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x)))), double_round_eq fexp1 fexp2 choice1 choice2 x *)
intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 x Px Hf1.
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
unfold double_round_eq.
(* Goal: forall _ : Rlt x (Rminus (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))), @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) x)) (round beta fexp1 (Znearest choice1) x) *)
set (x'' := round beta fexp2 (Znearest choice2) x).
(* Goal: forall (_ : forall (_ : @eq Z (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Z.add (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH))) (_ : Rle (Rminus (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))) x), double_round_eq fexp1 fexp2 choice1 choice2 x) (_ : forall (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : and (Rle (Rminus (midp fexp1 x) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))) x) (Rlt x (midp fexp1 x))), double_round_eq fexp1 fexp2 choice1 choice2 x) (_ : forall (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : @eq R x (midp fexp1 x)), double_round_eq fexp1 fexp2 choice1 choice2 x) (_ : forall (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : and (Rlt (midp fexp1 x) x) (Rle x (Rplus (midp fexp1 x) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))))), double_round_eq fexp1 fexp2 choice1 choice2 x), double_round_eq fexp1 fexp2 choice1 choice2 x *)
set (u1 := ulp beta fexp1 x).
(* Goal: forall (_ : forall (_ : @eq Z (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Z.add (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH))) (_ : Rle (Rminus (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))) x), double_round_eq fexp1 fexp2 choice1 choice2 x) (_ : forall (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : and (Rle (Rminus (midp fexp1 x) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))) x) (Rlt x (midp fexp1 x))), double_round_eq fexp1 fexp2 choice1 choice2 x) (_ : forall (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : @eq R x (midp fexp1 x)), double_round_eq fexp1 fexp2 choice1 choice2 x) (_ : forall (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : and (Rlt (midp fexp1 x) x) (Rle x (Rplus (midp fexp1 x) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))))), double_round_eq fexp1 fexp2 choice1 choice2 x), double_round_eq fexp1 fexp2 choice1 choice2 x *)
set (u2 := ulp beta fexp2 x).
(* Goal: forall _ : Rlt x (Rminus (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Rmult (Rinv (IZR (Zpos (xO xH)))) u2)), @eq R (round beta fexp1 (Znearest choice1) x'') (round beta fexp1 (Znearest choice1) x) *)
intro Hx.
assert (Hlx : bpow (ln_beta x - 1) <= x < bpow (ln_beta x)).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ destruct (ln_beta x) as (ex,Hex); simpl.
  rewrite <- (Rabs_right x); [|now apply Rle_ge; apply Rlt_le].
(* Goal: and (Rle (Fcore_Raux.bpow beta (Z.sub ex (Zpos xH))) (Rabs x)) (Rlt (Rabs x) (Fcore_Raux.bpow beta ex)) *)
  apply Hex.
  now apply Rgt_not_eq. }
rewrite (round_N_really_small_pos beta fexp1 choice1 x (ln_beta x));
  [|exact Hlx|omega].
destruct (Req_dec x'' 0) as [Zx''|Nzx''];
  [now rewrite Zx''; rewrite round_0; [reflexivity|apply valid_rnd_N]|].
rewrite (round_N_really_small_pos beta _ _ x'' (ln_beta x));
  [reflexivity| |omega].
(* Goal: and (Rle (Fcore_Raux.bpow beta (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH))) x'') (Rlt x'' (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) *)
split.
- apply round_large_pos_ge_pow.
  + now apply valid_rnd_N.
  + assert (0 <= x''); [|now fold x''; lra].
    rewrite <- (round_0 beta fexp2 (Znearest choice2)).
(* Goal: Rle (round beta fexp2 (Znearest choice2) (IZR Z0)) x'' *)
    now apply round_le; [|apply valid_rnd_N|apply Rlt_le].
  + apply Rle_trans with (Rabs x);
    [|now rewrite Rabs_right; [apply Rle_refl|apply Rle_ge; apply Rlt_le]].
(* Goal: and (Rle (Fcore_Raux.bpow beta (Z.sub ex (Zpos xH))) (Rabs x)) (Rlt (Rabs x) (Fcore_Raux.bpow beta ex)) *)
    destruct (ln_beta x) as (ex,Hex); simpl; apply Hex.
(* Goal: not (@eq R x (IZR Z0)) *)
    now apply Rgt_not_eq.
- replace x'' with (x + (x'' - x)) by ring.
  replace (bpow _) with (bpow (ln_beta x) - / 2 * u2 + / 2 * u2) by ring.
(* Goal: Rlt (Rplus x (Rminus x'' x)) (Rplus (Rminus (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Rmult (Rinv (IZR (Zpos (xO xH)))) u2)) (Rmult (Rinv (IZR (Zpos (xO xH)))) u2)) *)
  apply Rplus_lt_le_compat; [exact Hx|].
(* Goal: Rle (Rminus x'' x) (Rmult (Rinv (IZR (Zpos (xO xH)))) u2) *)
  apply Rabs_le_inv.
(* Goal: Rle (Rabs (Rminus x'' x)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x)) *)
  now apply error_le_half_ulp.
Qed.

Lemma double_round_all_mid_cases :
  forall fexp1 fexp2 : Z -> Z,
  Valid_exp fexp1 -> Valid_exp fexp2 ->
  forall (choice1 choice2 : Z -> bool),
  forall x,
  0 < x ->
  (fexp2 (ln_beta x) <= fexp1 (ln_beta x) - 1)%Z ->
  ((fexp1 (ln_beta x) = ln_beta x + 1 :> Z)%Z ->
   bpow (ln_beta x) - / 2 * ulp beta fexp2 x <= x ->
   double_round_eq fexp1 fexp2 choice1 choice2 x) ->
  ((fexp1 (ln_beta x) <= ln_beta x)%Z ->
   midp fexp1 x - / 2 * ulp beta fexp2 x <= x < midp fexp1 x ->
   double_round_eq fexp1 fexp2 choice1 choice2 x) ->
  ((fexp1 (ln_beta x) <= ln_beta x)%Z ->
   x = midp fexp1 x ->
   double_round_eq fexp1 fexp2 choice1 choice2 x) ->
  ((fexp1 (ln_beta x) <= ln_beta x)%Z ->
   midp fexp1 x < x <= midp fexp1 x + / 2 * ulp beta fexp2 x ->
   double_round_eq fexp1 fexp2 choice1 choice2 x) ->
  double_round_eq fexp1 fexp2 choice1 choice2 x.
Proof.
(* Goal: forall (fexp1 fexp2 : forall _ : Z, Z) (_ : Valid_exp fexp1) (_ : Valid_exp fexp2) (choice1 choice2 : forall _ : Z, bool) (x : R) (_ : Rlt (IZR Z0) x) (_ : Z.le (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Zpos xH))) (_ : forall (_ : @eq Z (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Z.add (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH))) (_ : Rle (Rminus (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))) x), double_round_eq fexp1 fexp2 choice1 choice2 x) (_ : forall (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : and (Rle (Rminus (midp fexp1 x) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))) x) (Rlt x (midp fexp1 x))), double_round_eq fexp1 fexp2 choice1 choice2 x) (_ : forall (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : @eq R x (midp fexp1 x)), double_round_eq fexp1 fexp2 choice1 choice2 x) (_ : forall (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : and (Rlt (midp fexp1 x) x) (Rle x (Rplus (midp fexp1 x) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))))), double_round_eq fexp1 fexp2 choice1 choice2 x), double_round_eq fexp1 fexp2 choice1 choice2 x *)
intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 x Px Hf2.
(* Goal: forall (_ : forall (_ : @eq Z (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Z.add (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH))) (_ : Rle (Rminus (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))) x), double_round_eq fexp1 fexp2 choice1 choice2 x) (_ : forall (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : and (Rle (Rminus (midp fexp1 x) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))) x) (Rlt x (midp fexp1 x))), double_round_eq fexp1 fexp2 choice1 choice2 x) (_ : forall (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : @eq R x (midp fexp1 x)), double_round_eq fexp1 fexp2 choice1 choice2 x) (_ : forall (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : and (Rlt (midp fexp1 x) x) (Rle x (Rplus (midp fexp1 x) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))))), double_round_eq fexp1 fexp2 choice1 choice2 x), double_round_eq fexp1 fexp2 choice1 choice2 x *)
set (x' := round beta fexp1 Zfloor x).
(* Goal: forall (_ : forall (_ : @eq Z (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Z.add (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH))) (_ : Rle (Rminus (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))) x), double_round_eq fexp1 fexp2 choice1 choice2 x) (_ : forall (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : and (Rle (Rminus (midp fexp1 x) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))) x) (Rlt x (midp fexp1 x))), double_round_eq fexp1 fexp2 choice1 choice2 x) (_ : forall (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : @eq R x (midp fexp1 x)), double_round_eq fexp1 fexp2 choice1 choice2 x) (_ : forall (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : and (Rlt (midp fexp1 x) x) (Rle x (Rplus (midp fexp1 x) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))))), double_round_eq fexp1 fexp2 choice1 choice2 x), double_round_eq fexp1 fexp2 choice1 choice2 x *)
set (u1 := ulp beta fexp1 x).
(* Goal: forall (_ : forall (_ : @eq Z (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Z.add (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH))) (_ : Rle (Rminus (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))) x), double_round_eq fexp1 fexp2 choice1 choice2 x) (_ : forall (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : and (Rle (Rminus (midp fexp1 x) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))) x) (Rlt x (midp fexp1 x))), double_round_eq fexp1 fexp2 choice1 choice2 x) (_ : forall (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : @eq R x (midp fexp1 x)), double_round_eq fexp1 fexp2 choice1 choice2 x) (_ : forall (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : and (Rlt (midp fexp1 x) x) (Rle x (Rplus (midp fexp1 x) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))))), double_round_eq fexp1 fexp2 choice1 choice2 x), double_round_eq fexp1 fexp2 choice1 choice2 x *)
set (u2 := ulp beta fexp2 x).
(* Goal: forall (_ : forall (_ : @eq Z (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Z.add (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH))) (_ : Rle (Rminus (Fcore_Raux.bpow beta (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Rmult (Rinv (IZR (Zpos (xO xH)))) u2)) x), double_round_eq fexp1 fexp2 choice1 choice2 x) (_ : forall (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : and (Rle (Rminus (midp fexp1 x) (Rmult (Rinv (IZR (Zpos (xO xH)))) u2)) x) (Rlt x (midp fexp1 x))), double_round_eq fexp1 fexp2 choice1 choice2 x) (_ : forall (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : @eq R x (midp fexp1 x)), double_round_eq fexp1 fexp2 choice1 choice2 x) (_ : forall (_ : Z.le (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (_ : and (Rlt (midp fexp1 x) x) (Rle x (Rplus (midp fexp1 x) (Rmult (Rinv (IZR (Zpos (xO xH)))) u2)))), double_round_eq fexp1 fexp2 choice1 choice2 x), double_round_eq fexp1 fexp2 choice1 choice2 x *)
intros Cz Clt Ceq Cgt.
destruct (Ztrichotomy (ln_beta x) (fexp1 (ln_beta x) - 1)) as [Hlt|[Heq|Hgt]].
- (* ln_beta x < fexp1 (ln_beta x) - 1 *)
  assert (H : (ln_beta x <= fexp1 (ln_beta x) - 2)%Z) by omega.
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 x *)
  now apply double_round_really_zero.
- (* ln_beta x = fexp1 (ln_beta x) - 1 *)
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  assert (H : (fexp1 (ln_beta x) = (ln_beta x + 1))%Z) by omega.
  destruct (Rlt_or_le x (bpow (ln_beta x) - / 2 * u2)) as [Hlt'|Hge'].
  + now apply double_round_zero.
  + now apply Cz.
- (* ln_beta x > fexp1 (ln_beta x) - 1 *)
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  assert (H : (fexp1 (ln_beta x) <= ln_beta x)%Z) by omega.
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 x *)
  destruct (Rtotal_order x (midp fexp1 x)) as [Hlt'|[Heq'|Hgt']].
  + (* x < midp fexp1 x *)
    destruct (Rlt_or_le x (midp fexp1 x - / 2 * u2)) as [Hlt''|Hle''].
    * now apply double_round_lt_mid_further_place; [| | |omega| |].
    * now apply Clt; [|split].
  + (* x = midp fexp1 x *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 x *)
    now apply Ceq.
  + (* x > midp fexp1 x *)
    destruct (Rle_or_lt x (midp fexp1 x + / 2 * u2)) as [Hlt''|Hle''].
    * now apply Cgt; [|split].
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
    * { destruct (generic_format_EM beta fexp1 x) as [Fx|Nfx].
        - (* generic_format beta fexp1 x *)
          unfold double_round_eq; rewrite (round_generic beta fexp2);
          [reflexivity|now apply valid_rnd_N|].
(* Goal: generic_format beta fexp2 x *)
          now apply (generic_inclusion_ln_beta beta fexp1); [omega|].
        - (* ~ generic_format beta fexp1 x *)
          assert (Hceil : round beta fexp1 Zceil x = x' + u1);
          [now apply round_UP_DN_ulp|].
          assert (Hf2' : (fexp2 (ln_beta x) <= fexp1 (ln_beta x) - 1)%Z);
            [omega|].
          assert (midp' fexp1 x + / 2 * ulp beta fexp2 x < x);
            [|now apply double_round_gt_mid_further_place].
(* Goal: Rlt (Rabs (Rminus (Rmult (Rmult x'' (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) (Rmult (Z2R (Zceil (scaled_mantissa beta fexp1 x))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
          revert Hle''; unfold midp, midp'; fold x'.
(* Goal: forall _ : Rlt (Rplus (Rplus x' (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 x))) (Rmult (Rinv (IZR (Zpos (xO xH)))) u2)) x, Rlt (Rplus (Rminus (round beta fexp1 Zceil x) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 x))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp2 x))) x *)
          rewrite Hceil; fold u1; fold u2.
          lra. }
Qed.

Lemma ln_beta_div_disj :
  forall x y : R,
  0 < x -> 0 < y ->
  ((ln_beta (x / y) = ln_beta x - ln_beta y :> Z)%Z
   \/ (ln_beta (x / y) = ln_beta x - ln_beta y + 1 :> Z)%Z).
Proof.
(* Goal: forall (x y : R) (_ : Rlt (IZR Z0) x) (_ : Rlt (IZR Z0) y), or (@eq Z (ln_beta_val beta (Rdiv x y) (Fcore_Raux.ln_beta beta (Rdiv x y))) (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (ln_beta_val beta y (Fcore_Raux.ln_beta beta y)))) (@eq Z (ln_beta_val beta (Rdiv x y) (Fcore_Raux.ln_beta beta (Rdiv x y))) (Z.add (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (ln_beta_val beta y (Fcore_Raux.ln_beta beta y))) (Zpos xH))) *)
intros x y Px Py.
(* Goal: or (@eq Z (ln_beta_val beta (Rdiv x y) (Fcore_Raux.ln_beta beta (Rdiv x y))) (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (ln_beta_val beta y (Fcore_Raux.ln_beta beta y)))) (@eq Z (ln_beta_val beta (Rdiv x y) (Fcore_Raux.ln_beta beta (Rdiv x y))) (Z.add (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (ln_beta_val beta y (Fcore_Raux.ln_beta beta y))) (Zpos xH))) *)
generalize (ln_beta_div beta x y Px Py).
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
omega.
Qed.

Definition double_round_div_hyp fexp1 fexp2 :=
  (forall ex, (fexp2 ex <= fexp1 ex - 1)%Z)
  /\ (forall ex ey, (fexp1 ex < ex)%Z -> (fexp1 ey < ey)%Z ->
                    (fexp1 (ex - ey) <= ex - ey + 1)%Z ->
                    (fexp2 (ex - ey) <= fexp1 ex - ey)%Z)
  /\ (forall ex ey, (fexp1 ex < ex)%Z -> (fexp1 ey < ey)%Z ->
                    (fexp1 (ex - ey + 1) <= ex - ey + 1 + 1)%Z ->
                    (fexp2 (ex - ey + 1) <= fexp1 ex - ey)%Z)
  /\ (forall ex ey, (fexp1 ex < ex)%Z -> (fexp1 ey < ey)%Z ->
                    (fexp1 (ex - ey) <= ex - ey)%Z ->
                    (fexp2 (ex - ey) <= fexp1 (ex - ey)
                                        + fexp1 ey - ey)%Z)
  /\ (forall ex ey, (fexp1 ex < ex)%Z -> (fexp1 ey < ey)%Z ->
                    (fexp1 (ex - ey) = ex - ey + 1)%Z ->
                    (fexp2 (ex - ey) <= ex - ey - ey + fexp1 ey)%Z).

Lemma double_round_div_aux0 :
  forall fexp1 fexp2 : Z -> Z,
  Valid_exp fexp1 -> Valid_exp fexp2 ->
  forall (choice1 choice2 : Z -> bool),
  double_round_div_hyp fexp1 fexp2 ->
  forall x y,
  0 < x -> 0 < y ->
  generic_format beta fexp1 x ->
  generic_format beta fexp1 y ->
  fexp1 (ln_beta (x / y)) = (ln_beta (x / y) + 1)%Z ->
  ~ (bpow (ln_beta (x / y)) - / 2 * ulp beta fexp2 (x / y) <= x / y).
Proof.
intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x y Px Py Fx Fy Hf1.
assert (Hfx : (fexp1 (ln_beta x) < ln_beta x)%Z);
  [now apply ln_beta_generic_gt; [|apply Rgt_not_eq|]|].
assert (Hfy : (fexp1 (ln_beta y) < ln_beta y)%Z);
  [now apply ln_beta_generic_gt; [|apply Rgt_not_eq|]|].
set (p := bpow (ln_beta (x / y))).
set (u2 := bpow (fexp2 (ln_beta (x / y)))).
(* Goal: generic_format beta fexp2 (Rplus x y) *)
revert Fx Fy.
(* Goal: forall (_ : generic_format beta fexp1 x) (_ : generic_format beta fexp1 a), False *)
unfold generic_format, F2R, scaled_mantissa, canonic_exp; simpl.
set (mx := Ztrunc (x * bpow (- fexp1 (ln_beta x)))).
set (my := Ztrunc (y * bpow (- fexp1 (ln_beta y)))).
(* Goal: forall (_ : @eq R x (Rmult (Z2R mx) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (_ : @eq R y (Rmult (Z2R my) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta y (Fcore_Raux.ln_beta beta y)))))), generic_format beta fexp2 (Rplus x y) *)
intros Fx Fy.
rewrite ulp_neq_0.
2: apply Rmult_integral_contrapositive_currified; [now apply Rgt_not_eq|idtac].
2: now apply Rinv_neq_0_compat, Rgt_not_eq.
intro Hl.
assert (Hr : x / y < p);
  [now apply Rabs_lt_inv; apply bpow_ln_beta_gt|].
apply (Rlt_irrefl (p - / 2 * u2)).
apply (Rle_lt_trans _ _ _ Hl).
apply (Rmult_lt_reg_r y _ _ Py).
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Rmult (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) *)
unfold Rdiv; rewrite Rmult_assoc.
rewrite Rinv_l; [|now apply Rgt_not_eq]; rewrite Rmult_1_r.
destruct (Zle_or_lt Z0 (fexp1 (ln_beta x) - ln_beta (x / y)
                        - fexp1 (ln_beta y))%Z) as [He|He].
- (* ln_beta (x / y) + fexp1 (ln_beta y) <= fexp1 (ln_beta x) *)
  apply Rle_lt_trans with (p * y - p * bpow (fexp1 (ln_beta y))).
  + rewrite Fx; rewrite Fy at 1.
    rewrite <- Rmult_assoc.
    rewrite (Rmult_comm p).
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    unfold p; bpow_simplify.
    apply (Rmult_le_reg_r (bpow (- ln_beta (x / y) - fexp1 (ln_beta y))));
      [now apply bpow_gt_0|].
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rmult (Rminus (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))))) *)
    rewrite Rmult_minus_distr_r.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    bpow_simplify.
    rewrite <- Z2R_Zpower; [|exact He].
    rewrite <- Z2R_mult.
    change 1 with (Z2R 1); rewrite <- Z2R_minus.
(* Goal: Rle (Z2R (Zceil (Rmult (Rminus x y) (Fcore_Raux.bpow beta (Z.opp (fexp (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH)))))))) (Z2R (Z.pow (radix_val beta) (Z.sub (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (fexp (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH)))) (Zpos xH)))) *)
    apply Z2R_le.
(* Goal: Rlt (Rplus (Rminus (round beta fexp1 Zceil (Rminus x y)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y)))) (Rminus (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y))) (Rminus x y))) (Rplus (Rminus x y) (Rminus (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y))) (Rminus x y))) *)
    apply (Zplus_le_reg_r _ _ 1); ring_simplify.
    apply Zlt_le_succ.
(* Goal: Z.lt (Znearest choice2 (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Z.add (Z.pow (radix_val beta) (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) (Zpos xH)) *)
    apply lt_Z2R.
(* Goal: @eq R (Rmult (Z2R (Z.mul (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Z.pow (radix_val beta) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    rewrite Z2R_mult.
    rewrite Z2R_Zpower; [|exact He].
    apply (Rmult_lt_reg_r (bpow (fexp1 (ln_beta y) + ln_beta (x / y))));
      [now apply bpow_gt_0|].
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    bpow_simplify.
    rewrite <- Fx.
(* Goal: Rlt x (Fcore_Raux.bpow beta (Z.add (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))))) *)
    rewrite bpow_plus.
    rewrite <- Rmult_assoc; rewrite <- Fy.
    fold p.
    apply (Rmult_lt_reg_r (/ y)); [now apply Rinv_0_lt_compat|].
(* Goal: forall _ : Rlt (Rplus (Rplus x' (Rmult (Rinv (IZR (Zpos (xO xH)))) u1)) (Rmult (Rinv (IZR (Zpos (xO xH)))) u2)) x, Rlt (Rplus (Rminus (Rplus x' u1) (Rmult (Rinv (IZR (Zpos (xO xH)))) u1)) (Rmult (Rinv (IZR (Zpos (xO xH)))) u2)) x *)
    field_simplify; lra.
  + rewrite Rmult_minus_distr_r.
(* Goal: Rlt (Rplus a (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta a (Fcore_Raux.ln_beta beta a)))))) (Rplus a (ulp beta fexp1 a)) *)
    unfold Rminus; apply Rplus_lt_compat_l.
(* Goal: Rlt (Ropp (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Ropp (IZR Z0)) *)
    apply Ropp_lt_contravar.
    apply Rlt_le_trans with (u2 * bpow (ln_beta y)).
    * rewrite <- (Rmult_1_l (u2 * _)).
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Rmult (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) *)
      rewrite Rmult_assoc.
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
      { apply Rmult_lt_compat.
        - lra.
        - now apply Rmult_le_pos; [apply bpow_ge_0|apply Rlt_le].
        - lra.
        - apply Rmult_lt_compat_l; [now apply bpow_gt_0|].
(* Goal: Rlt (sqrt x) (Fcore_Raux.bpow beta (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) *)
          apply Rabs_lt_inv.
          apply bpow_ln_beta_gt. }
    * unfold u2, p, ulp, canonic_exp; bpow_simplify; apply bpow_le.
      apply (Zplus_le_reg_r _ _ (- ln_beta y)); ring_simplify.
      rewrite (Zplus_comm (- _)); fold (Zminus (ln_beta (x / y)) (ln_beta y)).
      destruct (ln_beta_div_disj x y Px Py) as [Hxy|Hxy]; rewrite Hxy;
      [now apply Hexp; [| |rewrite <- Hxy]|].
      replace (_ - _ + 1)%Z with ((ln_beta x + 1) - ln_beta y)%Z by ring.
(* Goal: Z.le (fexp2 (ln_beta_val beta (Rdiv x y) (Fcore_Raux.ln_beta beta (Rdiv x y)))) (Z.sub (fexp1 (ln_beta_val beta (Rdiv x y) (Fcore_Raux.ln_beta beta (Rdiv x y)))) (Zpos xH)) *)
      apply Hexp.
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
      { now assert (fexp1 (ln_beta x + 1) <= ln_beta x)%Z;
        [apply valid_exp|omega]. }
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
      { assumption. }
      replace (_ + 1 - _)%Z with (ln_beta x - ln_beta y + 1)%Z by ring.
      now rewrite <- Hxy.
- (* fexp1 (ln_beta x) < ln_beta (x / y) + fexp1 (ln_beta y) *)
  apply Rle_lt_trans with (p * y - bpow (fexp1 (ln_beta x))).
  + rewrite Fx at 1; rewrite Fy at 1.
    apply (Rmult_le_reg_r (bpow (- fexp1 (ln_beta x))));
      [now apply bpow_gt_0|].
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rmult (Rminus (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))))) *)
    rewrite Rmult_minus_distr_r.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    bpow_simplify.
    rewrite (Rmult_comm p).
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    unfold p; bpow_simplify.
    rewrite <- Z2R_Zpower; [|omega].
    rewrite <- Z2R_mult.
    change 1 with (Z2R 1); rewrite <- Z2R_minus.
(* Goal: Rle (Z2R (Zceil (Rmult (Rminus x y) (Fcore_Raux.bpow beta (Z.opp (fexp (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH)))))))) (Z2R (Z.pow (radix_val beta) (Z.sub (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (fexp (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH)))) (Zpos xH)))) *)
    apply Z2R_le.
(* Goal: Rlt (Rplus (Rminus (round beta fexp1 Zceil (Rminus x y)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y)))) (Rminus (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y))) (Rminus x y))) (Rplus (Rminus x y) (Rminus (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y))) (Rminus x y))) *)
    apply (Zplus_le_reg_r _ _ 1); ring_simplify.
    apply Zlt_le_succ.
(* Goal: Z.lt (Znearest choice2 (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Z.add (Z.pow (radix_val beta) (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) (Zpos xH)) *)
    apply lt_Z2R.
(* Goal: @eq R (Rmult (Z2R (Z.mul (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Z.pow (radix_val beta) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    rewrite Z2R_mult.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Z2R (Z.pow (radix_val beta) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    rewrite Z2R_Zpower; [|omega].
    apply (Rmult_lt_reg_r (bpow (fexp1 (ln_beta x))));
      [now apply bpow_gt_0|bpow_simplify].
    rewrite <- Fx.
(* Goal: Rlt x (Fcore_Raux.bpow beta (Z.add (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))))) *)
    rewrite Zplus_comm; rewrite bpow_plus.
    rewrite <- Rmult_assoc; rewrite <- Fy.
    fold p.
    apply (Rmult_lt_reg_r (/ y)); [now apply Rinv_0_lt_compat|].
(* Goal: forall _ : Rlt (Rplus (Rplus x' (Rmult (Rinv (IZR (Zpos (xO xH)))) u1)) (Rmult (Rinv (IZR (Zpos (xO xH)))) u2)) x, Rlt (Rplus (Rminus (Rplus x' u1) (Rmult (Rinv (IZR (Zpos (xO xH)))) u1)) (Rmult (Rinv (IZR (Zpos (xO xH)))) u2)) x *)
    field_simplify; lra.
  + rewrite Rmult_minus_distr_r.
(* Goal: Rlt (Rplus a (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta a (Fcore_Raux.ln_beta beta a)))))) (Rplus a (ulp beta fexp1 a)) *)
    unfold Rminus; apply Rplus_lt_compat_l.
(* Goal: Rlt (Ropp (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Ropp (IZR Z0)) *)
    apply Ropp_lt_contravar.
    apply Rlt_le_trans with (u2 * bpow (ln_beta y)).
    * rewrite <- (Rmult_1_l (u2 * _)).
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Rmult (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) *)
      rewrite Rmult_assoc.
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
      { apply Rmult_lt_compat.
        - lra.
        - now apply Rmult_le_pos; [apply bpow_ge_0|apply Rlt_le].
        - lra.
        - apply Rmult_lt_compat_l; [now apply bpow_gt_0|].
(* Goal: Rlt (sqrt x) (Fcore_Raux.bpow beta (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) *)
          apply Rabs_lt_inv.
          apply bpow_ln_beta_gt. }
    * unfold u2, p, ulp, canonic_exp; bpow_simplify; apply bpow_le.
      apply (Zplus_le_reg_r _ _ (- ln_beta y)); ring_simplify.
      rewrite (Zplus_comm (- _)); fold (Zminus (ln_beta (x / y)) (ln_beta y)).
      destruct (ln_beta_div_disj x y Px Py) as [Hxy|Hxy]; rewrite Hxy;
      apply Hexp; try assumption; rewrite <- Hxy; rewrite Hf1; apply Zle_refl.
Qed.

Lemma double_round_div_aux1 :
  forall fexp1 fexp2 : Z -> Z,
  Valid_exp fexp1 -> Valid_exp fexp2 ->
  forall (choice1 choice2 : Z -> bool),
  double_round_div_hyp fexp1 fexp2 ->
  forall x y,
  0 < x -> 0 < y ->
  generic_format beta fexp1 x ->
  generic_format beta fexp1 y ->
  (fexp1 (ln_beta (x / y)) <= ln_beta (x / y))%Z ->
  ~ (midp fexp1 (x / y) - / 2 * ulp beta fexp2 (x / y)
     <= x / y
     < midp fexp1 (x / y)).
Proof.
intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x y Px Py Fx Fy Hf1.
assert (Hfx : (fexp1 (ln_beta x) < ln_beta x)%Z);
  [now apply ln_beta_generic_gt; [|apply Rgt_not_eq|]|].
assert (Hfy : (fexp1 (ln_beta y) < ln_beta y)%Z);
  [now apply ln_beta_generic_gt; [|apply Rgt_not_eq|]|].
assert (S : (x / y <> 0)%R).
apply Rmult_integral_contrapositive_currified; [now apply Rgt_not_eq|idtac].
now apply Rinv_neq_0_compat, Rgt_not_eq.
cut (~ (/ 2 * (ulp beta fexp1 (x / y) - ulp beta fexp2 (x / y))
        <= x / y - round beta fexp1 Zfloor (x / y)
        < / 2 * ulp beta fexp1 (x / y))).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ intro H; intro H'; apply H; split.
  - apply (Rplus_le_reg_l (round beta fexp1 Zfloor (x / y))).
(* Goal: Rlt (Rplus (Rminus (round beta fexp1 Zceil (Rminus x y)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y)))) (Rminus (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y))) (Rminus x y))) (Rplus (Rminus x y) (Rminus (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y))) (Rminus x y))) *)
    ring_simplify.
    apply H'.
  - apply (Rplus_lt_reg_l (round beta fexp1 Zfloor (x / y))).
(* Goal: Rlt (Rplus (Rminus (round beta fexp1 Zceil (Rminus x y)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y)))) (Rminus (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y))) (Rminus x y))) (Rplus (Rminus x y) (Rminus (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y))) (Rminus x y))) *)
    ring_simplify.
    apply H'. }
set (u1 := bpow (fexp1 (ln_beta (x / y)))).
set (u2 := bpow (fexp2 (ln_beta (x / y)))).
set (x' := round beta fexp1 Zfloor (x / y)).
rewrite 2!ulp_neq_0; trivial.
(* Goal: generic_format beta fexp2 (Rplus x y) *)
revert Fx Fy.
(* Goal: forall (_ : generic_format beta fexp1 x) (_ : generic_format beta fexp1 a), False *)
unfold generic_format, F2R, scaled_mantissa, canonic_exp; simpl.
set (mx := Ztrunc (x * bpow (- fexp1 (ln_beta x)))).
set (my := Ztrunc (y * bpow (- fexp1 (ln_beta y)))).
(* Goal: forall (_ : @eq R x (Rmult (Z2R mx) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (_ : @eq R y (Rmult (Z2R my) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta y (Fcore_Raux.ln_beta beta y)))))), generic_format beta fexp2 (Rplus x y) *)
intros Fx Fy.
intro Hlr.
apply (Rlt_irrefl (/ 2 * (u1 - u2))).
apply (Rle_lt_trans _ _ _ (proj1 Hlr)).
(* Goal: Rlt (Rplus (Rminus (round beta fexp1 Zceil (Rminus x y)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y)))) (Rminus (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y))) (Rminus x y))) (Rplus (Rminus x y) (Rminus (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y))) (Rminus x y))) *)
apply (Rplus_lt_reg_r x'); ring_simplify.
apply (Rmult_lt_reg_r y _ _ Py).
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Rmult (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) *)
unfold Rdiv; rewrite Rmult_assoc.
rewrite Rinv_l; [|now apply Rgt_not_eq]; rewrite Rmult_1_r.
(* Goal: @eq R (Rmult (Rplus (Z2R (Zfloor (scaled_mantissa beta fexp2 rd))) (Z2R (Z.mul n (Z.pow (radix_val beta) (Z.sub (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Zpos xH)) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (canonic_exp beta fexp2 x))) x *)
rewrite Rmult_minus_distr_r; rewrite Rmult_plus_distr_r.
apply (Rmult_lt_reg_l 2); [lra|].
rewrite Rmult_minus_distr_l; rewrite Rmult_plus_distr_l.
do 5 rewrite <- Rmult_assoc.
(* Goal: Rlt (Rmult (Rmult y (Fcore_Raux.bpow beta (Z.opp (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) (Rmult (Z2R (Zpos xH)) (Fcore_Raux.bpow beta (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
rewrite Rinv_r; [|lra]; do 2 rewrite Rmult_1_l.
destruct (Zle_or_lt Z0 (fexp1 (ln_beta x) - fexp1 (ln_beta (x / y))
                     - fexp1 (ln_beta y))%Z) as [He|He].
- (* fexp1 (ln_beta (x / y)) + fexp1 (ln_beta y)) <= fexp1 (ln_beta x) *)
  apply Rle_lt_trans with (2 * x' * y + u1 * y
                                        - bpow (fexp1 (ln_beta (x / y))
                                                + fexp1 (ln_beta y))).
  + rewrite Fx at 1; rewrite Fy at 1 2.
    apply (Rmult_le_reg_r (bpow (- fexp1 (ln_beta (x / y))
                                 - fexp1 (ln_beta y))));
      [now apply bpow_gt_0|].
    rewrite Rmult_minus_distr_r; rewrite (Rmult_plus_distr_r (_ * _ * _)).
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    bpow_simplify.
    replace (2 * x' * _ * _)
    with (2 * Z2R my * x' * bpow (- fexp1 (ln_beta (x / y)))) by ring.
    rewrite (Rmult_comm u1).
    unfold x', u1, round, F2R, ulp, scaled_mantissa, canonic_exp; simpl.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    bpow_simplify.
    rewrite <- Z2R_Zpower; [|exact He].
    change 2 with (Z2R 2).
    do 4 rewrite <- Z2R_mult.
    rewrite <- Z2R_plus.
    change 1 with (Z2R 1); rewrite <- Z2R_minus.
(* Goal: Rle (Z2R (Zceil (Rmult (Rminus x y) (Fcore_Raux.bpow beta (Z.opp (fexp (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH)))))))) (Z2R (Z.pow (radix_val beta) (Z.sub (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (fexp (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH)))) (Zpos xH)))) *)
    apply Z2R_le.
(* Goal: Rlt (Rplus (Rminus (round beta fexp1 Zceil (Rminus x y)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y)))) (Rminus (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y))) (Rminus x y))) (Rplus (Rminus x y) (Rminus (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y))) (Rminus x y))) *)
    apply (Zplus_le_reg_r _ _ 1); ring_simplify.
    apply Zlt_le_succ.
(* Goal: Z.lt (Znearest choice2 (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Z.add (Z.pow (radix_val beta) (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) (Zpos xH)) *)
    apply lt_Z2R.
(* Goal: Rlt (Z2R (Z.mul (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Z.pow (radix_val beta) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Z2R (Z.add (Z.mul (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Z.pow (radix_val beta) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Zpos xH))) *)
    rewrite Z2R_plus.
    do 4 rewrite Z2R_mult; simpl.
    rewrite Z2R_Zpower; [|exact He].
    apply (Rmult_lt_reg_r (bpow (fexp1 (ln_beta (x / y))
                                 + fexp1 (ln_beta y))));
      [now apply bpow_gt_0|bpow_simplify].
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Rmult (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) *)
    rewrite Rmult_assoc.
    rewrite <- Fx.
    rewrite (Rmult_plus_distr_r _ _ (Fcore_Raux.bpow _ _)).
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Rmult (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) *)
    rewrite Rmult_assoc.
(* Goal: Rlt x (Fcore_Raux.bpow beta (Z.add (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))))) *)
    rewrite bpow_plus.
    rewrite <- (Rmult_assoc (Z2R (Zfloor _))).
    change (Z2R (Zfloor _) * _) with x'.
    do 2 rewrite (Rmult_comm _ (bpow (fexp1 (ln_beta y)))).
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Rmult (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) *)
    rewrite Rmult_assoc.
    do 2 rewrite <- (Rmult_assoc (Z2R my)).
    rewrite <- Fy.
    change (bpow _) with u1.
    apply (Rmult_lt_reg_l (/ 2)); [lra|].
    rewrite Rmult_plus_distr_l.
    do 4 rewrite <- Rmult_assoc.
(* Goal: Rlt (Rmult (Rmult y (Fcore_Raux.bpow beta (Z.opp (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) (Rmult (Z2R (Zpos xH)) (Fcore_Raux.bpow beta (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
    rewrite Rinv_l; [|lra]; do 2 rewrite Rmult_1_l.
    apply (Rplus_lt_reg_r (- y * x')); ring_simplify.
    apply (Rmult_lt_reg_l (/ y)); [now apply Rinv_0_lt_compat|].
    rewrite Rmult_minus_distr_l.
    do 3 rewrite <- Rmult_assoc.
(* Goal: Rlt (Rmult (Rmult y (Fcore_Raux.bpow beta (Z.opp (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) (Rmult (Z2R (Zpos xH)) (Fcore_Raux.bpow beta (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
    rewrite Rinv_l; [|now apply Rgt_not_eq]; do 2 rewrite Rmult_1_l.
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))) (Fcore_Raux.bpow beta (Z.opp (Zpos xH)))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))) *)
    now rewrite Rmult_comm.
  + apply Rplus_lt_compat_l.
(* Goal: Rlt (Ropp (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Ropp (IZR Z0)) *)
    apply Ropp_lt_contravar.
    apply Rlt_le_trans with (u2 * bpow (ln_beta y)).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
    * { apply Rmult_lt_compat_l.
        - apply bpow_gt_0.
        - apply Rabs_lt_inv.
          apply bpow_ln_beta_gt. }
    * unfold u2, ulp, canonic_exp; bpow_simplify; apply bpow_le.
      apply (Zplus_le_reg_r _ _ (- ln_beta y)); ring_simplify.
      rewrite <- Zplus_assoc; rewrite (Zplus_comm (- _)).
      destruct (ln_beta_div_disj x y Px Py) as [Hxy|Hxy]; rewrite Hxy;
      [now apply Hexp; [| |rewrite <- Hxy]|].
      replace (_ - _ + 1)%Z with ((ln_beta x + 1) - ln_beta y)%Z by ring.
(* Goal: Z.le (fexp2 (ln_beta_val beta (Rdiv x y) (Fcore_Raux.ln_beta beta (Rdiv x y)))) (Z.sub (fexp1 (ln_beta_val beta (Rdiv x y) (Fcore_Raux.ln_beta beta (Rdiv x y)))) (Zpos xH)) *)
      apply Hexp.
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
      { now assert (fexp1 (ln_beta x + 1) <= ln_beta x)%Z;
        [apply valid_exp|omega]. }
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
      { assumption. }
      replace (_ + 1 - _)%Z with (ln_beta x - ln_beta y + 1)%Z by ring.
      now rewrite <- Hxy.
- (* fexp1 (ln_beta x) < fexp1 (ln_beta (x / y)) + fexp1 (ln_beta y) *)
  apply Rle_lt_trans with (2 * x' * y + u1 * y - bpow (fexp1 (ln_beta x))).
  + rewrite Fx at 1; rewrite Fy at 1 2.
    apply (Rmult_le_reg_r (bpow (- fexp1 (ln_beta x))));
      [now apply bpow_gt_0|].
    rewrite Rmult_minus_distr_r; rewrite (Rmult_plus_distr_r (_ * _ * _)).
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    bpow_simplify.
    replace (2 * x' * _ * _)
    with (2 * Z2R my * x' * bpow (fexp1 (ln_beta y) - fexp1 (ln_beta x))) by ring.
    rewrite (Rmult_comm u1).
    unfold x', u1, round, F2R, ulp, scaled_mantissa, canonic_exp; simpl.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    bpow_simplify.
    rewrite <- (Z2R_Zpower _ (_ - _)%Z); [|omega].
    change 2 with (Z2R 2).
    do 5 rewrite <- Z2R_mult.
    rewrite <- Z2R_plus.
    change 1 with (Z2R 1); rewrite <- Z2R_minus.
(* Goal: Rle (Z2R (Zceil (Rmult (Rminus x y) (Fcore_Raux.bpow beta (Z.opp (fexp (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH)))))))) (Z2R (Z.pow (radix_val beta) (Z.sub (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (fexp (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH)))) (Zpos xH)))) *)
    apply Z2R_le.
(* Goal: Rlt (Rplus (Rminus (round beta fexp1 Zceil (Rminus x y)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y)))) (Rminus (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y))) (Rminus x y))) (Rplus (Rminus x y) (Rminus (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y))) (Rminus x y))) *)
    apply (Zplus_le_reg_r _ _ 1); ring_simplify.
    apply Zlt_le_succ.
(* Goal: Z.lt (Znearest choice2 (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Z.add (Z.pow (radix_val beta) (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) (Zpos xH)) *)
    apply lt_Z2R.
(* Goal: Rlt (Z2R (Z.mul (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Z.pow (radix_val beta) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Z2R (Z.add (Z.mul (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Z.pow (radix_val beta) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Zpos xH))) *)
    rewrite Z2R_plus.
    do 5 rewrite Z2R_mult; simpl.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Z2R (Z.pow (radix_val beta) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    rewrite Z2R_Zpower; [|omega].
    apply (Rmult_lt_reg_r (bpow (fexp1 (ln_beta x))));
      [now apply bpow_gt_0|].
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Rmult (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) *)
    rewrite Rmult_assoc.
    rewrite <- Fx.
    rewrite (Rmult_plus_distr_r _ _ (Fcore_Raux.bpow _ _)).
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    bpow_simplify.
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Rmult (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) *)
    rewrite Rmult_assoc.
(* Goal: Rlt x (Fcore_Raux.bpow beta (Z.add (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))))) *)
    rewrite bpow_plus.
    rewrite <- (Rmult_assoc (Z2R (Zfloor _))).
    change (Z2R (Zfloor _) * _) with x'.
    do 2 rewrite (Rmult_comm _ (bpow (fexp1 (ln_beta y)))).
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Rmult (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) *)
    rewrite Rmult_assoc.
    do 2 rewrite <- (Rmult_assoc (Z2R my)).
    rewrite <- Fy.
    change (bpow _) with u1.
    apply (Rmult_lt_reg_l (/ 2)); [lra|].
    rewrite Rmult_plus_distr_l.
    do 4 rewrite <- Rmult_assoc.
(* Goal: Rlt (Rmult (Rmult y (Fcore_Raux.bpow beta (Z.opp (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) (Rmult (Z2R (Zpos xH)) (Fcore_Raux.bpow beta (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
    rewrite Rinv_l; [|lra]; do 2 rewrite Rmult_1_l.
    apply (Rplus_lt_reg_r (- y * x')); ring_simplify.
    apply (Rmult_lt_reg_l (/ y)); [now apply Rinv_0_lt_compat|].
    rewrite Rmult_minus_distr_l.
    do 3 rewrite <- Rmult_assoc.
(* Goal: Rlt (Rmult (Rmult y (Fcore_Raux.bpow beta (Z.opp (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) (Rmult (Z2R (Zpos xH)) (Fcore_Raux.bpow beta (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
    rewrite Rinv_l; [|now apply Rgt_not_eq]; do 2 rewrite Rmult_1_l.
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))) (Fcore_Raux.bpow beta (Z.opp (Zpos xH)))) (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))))) *)
    now rewrite Rmult_comm.
  + apply Rplus_lt_compat_l.
(* Goal: Rlt (Ropp (Rmult (Rinv (IZR (Zpos (xO xH)))) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Ropp (IZR Z0)) *)
    apply Ropp_lt_contravar.
    apply Rlt_le_trans with (u2 * bpow (ln_beta y)).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
    * { apply Rmult_lt_compat_l.
        - apply bpow_gt_0.
        - apply Rabs_lt_inv.
          apply bpow_ln_beta_gt. }
    * unfold u2, ulp, canonic_exp; bpow_simplify; apply bpow_le.
      apply (Zplus_le_reg_r _ _ (- ln_beta y)); ring_simplify.
      rewrite (Zplus_comm (- _)).
      destruct (ln_beta_div_disj x y Px Py) as [Hxy|Hxy]; rewrite Hxy;
      apply Hexp; try assumption; rewrite <- Hxy; omega.
Qed.

Lemma double_round_div_aux2 :
  forall fexp1 fexp2 : Z -> Z,
  Valid_exp fexp1 -> Valid_exp fexp2 ->
  forall (choice1 choice2 : Z -> bool),
  double_round_div_hyp fexp1 fexp2 ->
  forall x y,
  0 < x -> 0 < y ->
  generic_format beta fexp1 x ->
  generic_format beta fexp1 y ->
  (fexp1 (ln_beta (x / y)) <= ln_beta (x / y))%Z ->
  ~ (midp fexp1 (x / y)
     < x / y
     <= midp fexp1 (x / y) + / 2 * ulp beta fexp2 (x / y)).
Proof.
intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Hexp x y Px Py Fx Fy Hf1.
assert (Hfx : (fexp1 (ln_beta x) < ln_beta x)%Z);
  [now apply ln_beta_generic_gt; [|apply Rgt_not_eq|]|].
assert (Hfy : (fexp1 (ln_beta y) < ln_beta y)%Z);
  [now apply ln_beta_generic_gt; [|apply Rgt_not_eq|]|].
cut (~ (/ 2 * ulp beta fexp1 (x / y)
        < x / y - round beta fexp1 Zfloor (x / y)
        <= / 2 * (ulp beta fexp1 (x / y) + ulp beta fexp2 (x / y)))).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ intro H; intro H'; apply H; split.
  - apply (Rplus_lt_reg_l (round beta fexp1 Zfloor (x / y))).
(* Goal: Rlt (Rplus (Rminus (round beta fexp1 Zceil (Rminus x y)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y)))) (Rminus (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y))) (Rminus x y))) (Rplus (Rminus x y) (Rminus (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y))) (Rminus x y))) *)
    ring_simplify.
    apply H'.
  - apply (Rplus_le_reg_l (round beta fexp1 Zfloor (x / y))).
(* Goal: Rlt (Rplus (Rminus (round beta fexp1 Zceil (Rminus x y)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y)))) (Rminus (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y))) (Rminus x y))) (Rplus (Rminus x y) (Rminus (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y))) (Rminus x y))) *)
    ring_simplify.
    apply H'. }
set (u1 := bpow (fexp1 (ln_beta (x / y)))).
set (u2 := bpow (fexp2 (ln_beta (x / y)))).
set (x' := round beta fexp1 Zfloor (x / y)).
assert (S : (x / y <> 0)%R).
apply Rmult_integral_contrapositive_currified; [now apply Rgt_not_eq|idtac].
now apply Rinv_neq_0_compat, Rgt_not_eq.
rewrite 2!ulp_neq_0; trivial.
(* Goal: generic_format beta fexp2 (Rplus x y) *)
revert Fx Fy.
(* Goal: forall (_ : generic_format beta fexp1 x) (_ : generic_format beta fexp1 a), False *)
unfold generic_format, F2R, scaled_mantissa, canonic_exp; simpl.
set (mx := Ztrunc (x * bpow (- fexp1 (ln_beta x)))).
set (my := Ztrunc (y * bpow (- fexp1 (ln_beta y)))).
(* Goal: forall (_ : @eq R x (Rmult (Z2R mx) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (_ : @eq R y (Rmult (Z2R my) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta y (Fcore_Raux.ln_beta beta y)))))), generic_format beta fexp2 (Rplus x y) *)
intros Fx Fy.
intro Hlr.
apply (Rlt_irrefl (/ 2 * (u1 + u2))).
apply Rlt_le_trans with (x / y - x'); [|now apply Hlr].
(* Goal: Rlt (Rplus (Rminus (round beta fexp1 Zceil (Rminus x y)) (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y)))) (Rminus (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y))) (Rminus x y))) (Rplus (Rminus x y) (Rminus (Rmult (Rinv (IZR (Zpos (xO xH)))) (ulp beta fexp1 (Rminus x y))) (Rminus x y))) *)
apply (Rplus_lt_reg_r x'); ring_simplify.
apply (Rmult_lt_reg_r y _ _ Py).
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Rmult (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) *)
unfold Rdiv; rewrite Rmult_assoc.
rewrite Rinv_l; [|now apply Rgt_not_eq]; rewrite Rmult_1_r.
(* Goal: @eq R (Rmult (Rplus (Z2R (Zfloor (scaled_mantissa beta fexp2 rd))) (Z2R (Z.mul n (Z.pow (radix_val beta) (Z.sub (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Zpos xH)) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (canonic_exp beta fexp2 x))) x *)
do 2 rewrite Rmult_plus_distr_r.
apply (Rmult_lt_reg_l 2); [lra|].
do 2 rewrite Rmult_plus_distr_l.
do 5 rewrite <- Rmult_assoc.
(* Goal: Rlt (Rmult (Rmult y (Fcore_Raux.bpow beta (Z.opp (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) (Rmult (Z2R (Zpos xH)) (Fcore_Raux.bpow beta (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
rewrite Rinv_r; [|lra]; do 2 rewrite Rmult_1_l.
destruct (Zle_or_lt Z0 (fexp1 (ln_beta x) - fexp1 (ln_beta (x / y))
                     - fexp1 (ln_beta y))%Z) as [He|He].
- (* fexp1 (ln_beta (x / y)) + fexp1 (ln_beta y) <= fexp1 (ln_beta x) *)
  apply Rlt_le_trans with (u1 * y + bpow (fexp1 (ln_beta (x / y))
                                          + fexp1 (ln_beta y))
                           + 2 * x' * y).
  + apply Rplus_lt_compat_r, Rplus_lt_compat_l.
    apply Rlt_le_trans with (u2 * bpow (ln_beta y)).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
    * { apply Rmult_lt_compat_l.
        - apply bpow_gt_0.
        - apply Rabs_lt_inv.
          apply bpow_ln_beta_gt. }
    * unfold u2, ulp, canonic_exp; bpow_simplify; apply bpow_le.
      apply (Zplus_le_reg_r _ _ (- ln_beta y)); ring_simplify.
      rewrite <- Zplus_assoc; rewrite (Zplus_comm (- _)).
      destruct (ln_beta_div_disj x y Px Py) as [Hxy|Hxy]; rewrite Hxy;
      [now apply Hexp; [| |rewrite <- Hxy]|].
      replace (_ - _ + 1)%Z with ((ln_beta x + 1) - ln_beta y)%Z by ring.
(* Goal: Z.le (fexp2 (ln_beta_val beta (Rdiv x y) (Fcore_Raux.ln_beta beta (Rdiv x y)))) (Z.sub (fexp1 (ln_beta_val beta (Rdiv x y) (Fcore_Raux.ln_beta beta (Rdiv x y)))) (Zpos xH)) *)
      apply Hexp.
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
      { now assert (fexp1 (ln_beta x + 1) <= ln_beta x)%Z;
        [apply valid_exp|omega]. }
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
      { assumption. }
      replace (_ + 1 - _)%Z with (ln_beta x - ln_beta y + 1)%Z by ring.
      now rewrite <- Hxy.
  + apply Rge_le; rewrite Fx at 1; apply Rle_ge.
    replace (u1 * y) with (u1 * (Z2R my * bpow (fexp1 (ln_beta y))));
      [|now apply eq_sym; rewrite Fy at 1].
    replace (2 * x' * y) with (2 * x' * (Z2R my * bpow (fexp1 (ln_beta y))));
      [|now apply eq_sym; rewrite Fy at 1].
    apply (Rmult_le_reg_r (bpow (- fexp1 (ln_beta (x / y))
                                 - fexp1 (ln_beta y))));
      [now apply bpow_gt_0|].
(* Goal: @eq R (Rmult (Rplus (Z2R (Zfloor (scaled_mantissa beta fexp2 rd))) (Z2R (Z.mul n (Z.pow (radix_val beta) (Z.sub (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Zpos xH)) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (canonic_exp beta fexp2 x))) x *)
    do 2 rewrite Rmult_plus_distr_r.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    bpow_simplify.
    rewrite (Rmult_comm u1).
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    unfold u1, ulp, canonic_exp; bpow_simplify.
    rewrite (Rmult_assoc 2).
    rewrite (Rmult_comm x').
    rewrite (Rmult_assoc 2).
    unfold x', round, F2R, scaled_mantissa, canonic_exp; simpl.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    bpow_simplify.
    rewrite <- (Z2R_Zpower _ (_ - _)%Z); [|exact He].
    change 2 with (Z2R 2).
    do 4 rewrite <- Z2R_mult.
    change 1 with (Z2R 1); do 2 rewrite <- Z2R_plus.
(* Goal: Rle (Z2R (Zceil (Rmult (Rminus x y) (Fcore_Raux.bpow beta (Z.opp (fexp (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH)))))))) (Z2R (Z.pow (radix_val beta) (Z.sub (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (fexp (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH)))) (Zpos xH)))) *)
    apply Z2R_le.
    rewrite Zplus_comm, Zplus_assoc.
    apply Zlt_le_succ.
(* Goal: Z.lt (Znearest choice2 (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Z.add (Z.pow (radix_val beta) (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) (Zpos xH)) *)
    apply lt_Z2R.
(* Goal: Rlt (Z2R (Z.mul (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Z.pow (radix_val beta) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Z2R (Z.add (Z.mul (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Z.pow (radix_val beta) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Zpos xH))) *)
    rewrite Z2R_plus.
    do 4 rewrite Z2R_mult; simpl.
    rewrite Z2R_Zpower; [|exact He].
    apply (Rmult_lt_reg_r (bpow (fexp1 (ln_beta y))));
      [now apply bpow_gt_0|].
(* Goal: @eq R (Rmult (Rplus (Z2R (Zfloor (scaled_mantissa beta fexp2 rd))) (Z2R (Z.mul n (Z.pow (radix_val beta) (Z.sub (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Zpos xH)) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (canonic_exp beta fexp2 x))) x *)
    rewrite Rmult_plus_distr_r.
    rewrite (Rmult_comm _ (Z2R _)).
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Rmult (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) *)
    do 2 rewrite Rmult_assoc.
    rewrite <- Fy.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    bpow_simplify.
(* Goal: Rlt x (Fcore_Raux.bpow beta (Z.add (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))))) *)
    unfold Zminus; rewrite bpow_plus.
    rewrite (Rmult_assoc _ (Z2R mx)).
    rewrite <- (Rmult_assoc (Z2R mx)).
    rewrite <- Fx.
    apply (Rmult_lt_reg_r (bpow (fexp1 (ln_beta (x / y)))));
      [now apply bpow_gt_0|].
(* Goal: @eq R (Rmult (Rplus (Z2R (Zfloor (scaled_mantissa beta fexp2 rd))) (Z2R (Z.mul n (Z.pow (radix_val beta) (Z.sub (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Zpos xH)) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (canonic_exp beta fexp2 x))) x *)
    rewrite Rmult_plus_distr_r.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    bpow_simplify.
    rewrite (Rmult_comm _ y).
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Rmult (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) *)
    do 2 rewrite Rmult_assoc.
    change (Z2R (Zfloor _) * _) with x'.
    change (bpow _) with u1.
    apply (Rmult_lt_reg_l (/ 2)); [lra|].
    rewrite Rmult_plus_distr_l.
    do 4 rewrite <- Rmult_assoc.
(* Goal: Rlt (Rmult (Rmult y (Fcore_Raux.bpow beta (Z.opp (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) (Rmult (Z2R (Zpos xH)) (Fcore_Raux.bpow beta (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
    rewrite Rinv_l; [|lra]; do 2 rewrite Rmult_1_l.
    apply (Rplus_lt_reg_r (- y * x')); ring_simplify.
    apply (Rmult_lt_reg_l (/ y)); [now apply Rinv_0_lt_compat|].
    rewrite Rmult_plus_distr_l.
    do 3 rewrite <- Rmult_assoc.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rmult x (Ropp (Rinv (Ropp y)))))) (round beta fexp1 (Znearest choice1) (Rmult x (Ropp (Rinv (Ropp y))))) *)
    rewrite Ropp_mult_distr_r_reverse.
(* Goal: Rle (Rmult (Ropp (Rinv (IZR (Zpos (xO xH))))) u2) (Rminus (sqrt x) (Rplus a (Rmult (Rinv (IZR (Zpos (xO xH)))) u1))) *)
    rewrite Ropp_mult_distr_l_reverse.
(* Goal: Rlt (Rmult (Rmult y (Fcore_Raux.bpow beta (Z.opp (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) (Rmult (Z2R (Zpos xH)) (Fcore_Raux.bpow beta (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
    rewrite Rinv_l; [|now apply Rgt_not_eq]; do 2 rewrite Rmult_1_l.
    rewrite (Rmult_comm (/ y)).
    now rewrite (Rplus_comm (- x')).
- (* fexp1 (ln_beta x) < fexp1 (ln_beta (x / y)) + fexp1 (ln_beta y) *)
  apply Rlt_le_trans with (2 * x' * y + u1 * y + bpow (fexp1 (ln_beta x))).
  + rewrite Rplus_comm, Rplus_assoc; do 2 apply Rplus_lt_compat_l.
    apply Rlt_le_trans with (u2 * bpow (ln_beta y)).
    * apply Rmult_lt_compat_l.
(* Goal: Rlt (IZR Z0) (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))) *)
      now apply bpow_gt_0.
(* Goal: Rlt (Rabs (sqrt x)) (Fcore_Raux.bpow beta (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) *)
      now apply Rabs_lt_inv; apply bpow_ln_beta_gt.
    * unfold u2, ulp, canonic_exp; bpow_simplify; apply bpow_le.
      apply (Zplus_le_reg_r _ _ (- ln_beta y)); ring_simplify.
      rewrite (Zplus_comm (- _)).
      destruct (ln_beta_div_disj x y Px Py) as [Hxy|Hxy]; rewrite Hxy;
      apply Hexp; try assumption; rewrite <- Hxy; omega.
  + apply Rge_le; rewrite Fx at 1; apply Rle_ge.
    rewrite Fy at 1 2.
    apply (Rmult_le_reg_r (bpow (- fexp1 (ln_beta x))));
      [now apply bpow_gt_0|].
(* Goal: @eq R (Rmult (Rplus (Z2R (Zfloor (scaled_mantissa beta fexp2 rd))) (Z2R (Z.mul n (Z.pow (radix_val beta) (Z.sub (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Zpos xH)) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (canonic_exp beta fexp2 x))) x *)
    do 2 rewrite Rmult_plus_distr_r.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    bpow_simplify.
    replace (2 * x' * _ * _)
    with (2 * Z2R my * x' * bpow (fexp1 (ln_beta y) - fexp1 (ln_beta x))) by ring.
    rewrite (Rmult_comm u1).
    unfold x', u1, round, F2R, ulp, scaled_mantissa, canonic_exp; simpl.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    bpow_simplify.
    rewrite <- (Z2R_Zpower _ (_ - _)%Z); [|omega].
    change 2 with (Z2R 2).
    do 5 rewrite <- Z2R_mult.
    change 1 with (Z2R 1); do 2 rewrite <- Z2R_plus.
(* Goal: Rle (Z2R (Zceil (Rmult (Rminus x y) (Fcore_Raux.bpow beta (Z.opp (fexp (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH)))))))) (Z2R (Z.pow (radix_val beta) (Z.sub (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (fexp (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (Zpos xH)))) (Zpos xH)))) *)
    apply Z2R_le.
    apply Zlt_le_succ.
(* Goal: Z.lt (Znearest choice2 (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Z.add (Z.pow (radix_val beta) (Z.sub (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) (Zpos xH)) *)
    apply lt_Z2R.
(* Goal: Rlt (Z2R (Z.mul (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Z.pow (radix_val beta) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Z2R (Z.add (Z.mul (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Z.pow (radix_val beta) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Zpos xH))) *)
    rewrite Z2R_plus.
    do 5 rewrite Z2R_mult; simpl.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Z2R (Z.pow (radix_val beta) (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    rewrite Z2R_Zpower; [|omega].
    apply (Rmult_lt_reg_r (bpow (fexp1 (ln_beta x))));
      [now apply bpow_gt_0|].
    rewrite (Rmult_assoc _ (Z2R mx)).
    rewrite <- Fx.
(* Goal: @eq R (Rmult (Rplus (Z2R (Zfloor (scaled_mantissa beta fexp2 rd))) (Z2R (Z.mul n (Z.pow (radix_val beta) (Z.sub (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (Zpos xH)) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (canonic_exp beta fexp2 x))) x *)
    rewrite Rmult_plus_distr_r.
(* Goal: @eq R (Rmult (Rmult (Z2R (Zfloor (Rmult x (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))))) (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))) (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) rd *)
    bpow_simplify.
(* Goal: Rlt x (Fcore_Raux.bpow beta (Z.add (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))) (fexp1 (ln_beta_val beta (sqrt x) (Fcore_Raux.ln_beta beta (sqrt x)))))) *)
    rewrite bpow_plus.
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Rmult (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) *)
    rewrite Rmult_assoc.
    rewrite <- (Rmult_assoc (Z2R _)).
    change (Z2R _ * bpow _) with x'.
    do 2 rewrite (Rmult_comm _ (bpow (fexp1 (ln_beta y)))).
(* Goal: Rle (Rmult (Fcore_Raux.bpow beta (Z.sub (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y)))) (Zpos xH))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Rmult (Rmult (Rinv (IZR (Zpos (xO xH)))) (Rminus (Fcore_Raux.bpow beta (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))) (Fcore_Raux.bpow beta (fexp2 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) (Fcore_Raux.bpow beta (Z.opp (fexp1 (ln_beta_val beta (Rminus x y) (Fcore_Raux.ln_beta beta (Rminus x y))))))) *)
    rewrite Rmult_assoc.
    do 2 rewrite <- (Rmult_assoc (Z2R my)).
    rewrite <- Fy.
    change (bpow _) with u1.
    apply (Rmult_lt_reg_l (/ 2)); [lra|].
    rewrite Rmult_plus_distr_l.
    do 4 rewrite <- Rmult_assoc.
(* Goal: Rlt (Rmult (Rmult y (Fcore_Raux.bpow beta (Z.opp (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) (Rmult (Z2R (Zpos xH)) (Fcore_Raux.bpow beta (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
    rewrite Rinv_l; [|lra]; do 2 rewrite Rmult_1_l.
    apply (Rplus_lt_reg_r (- y * x')); ring_simplify.
    apply (Rmult_lt_reg_l (/ y)); [now apply Rinv_0_lt_compat|].
    rewrite Rmult_plus_distr_l.
    do 3 rewrite <- Rmult_assoc.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rmult x (Ropp (Rinv (Ropp y)))))) (round beta fexp1 (Znearest choice1) (Rmult x (Ropp (Rinv (Ropp y))))) *)
    rewrite Ropp_mult_distr_r_reverse.
(* Goal: Rle (Rmult (Ropp (Rinv (IZR (Zpos (xO xH))))) u2) (Rminus (sqrt x) (Rplus a (Rmult (Rinv (IZR (Zpos (xO xH)))) u1))) *)
    rewrite Ropp_mult_distr_l_reverse.
(* Goal: Rlt (Rmult (Rmult y (Fcore_Raux.bpow beta (Z.opp (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x)))))) (Fcore_Raux.bpow beta (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) (Rmult (Z2R (Zpos xH)) (Fcore_Raux.bpow beta (fexp (ln_beta_val beta x (Fcore_Raux.ln_beta beta x))))) *)
    rewrite Rinv_l; [|now apply Rgt_not_eq]; do 2 rewrite Rmult_1_l.
    rewrite (Rmult_comm (/ y)).
    now rewrite (Rplus_comm (- x')).
Qed.

Lemma double_round_div_aux :
  forall fexp1 fexp2 : Z -> Z,
  Valid_exp fexp1 -> Valid_exp fexp2 ->
  forall (choice1 choice2 : Z -> bool),
  (exists n, (beta = 2 * n :> Z)%Z) ->
  double_round_div_hyp fexp1 fexp2 ->
  forall x y,
  0 < x -> 0 < y ->
  generic_format beta fexp1 x ->
  generic_format beta fexp1 y ->
  double_round_eq fexp1 fexp2 choice1 choice2 (x / y).
Proof.
(* Goal: forall (fexp1 fexp2 : forall _ : Z, Z) (_ : Valid_exp fexp1) (_ : Valid_exp fexp2) (choice1 choice2 : forall _ : Z, bool) (_ : @ex Z (fun n : Z => @eq Z (radix_val beta) (Z.mul (Zpos (xO xH)) n))) (_ : double_round_div_hyp fexp1 fexp2) (x y : R) (_ : Rlt (IZR Z0) x) (_ : Rlt (IZR Z0) y) (_ : generic_format beta fexp1 x) (_ : generic_format beta fexp1 y), double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Ebeta Hexp x y Px Py Fx Fy.
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
assert (Pxy : 0 < x / y).
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
{ apply Rmult_lt_0_compat; [exact Px|].
  now apply Rinv_0_lt_compat. }
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
apply double_round_all_mid_cases.
(* Goal: Valid_exp fexp1 *)
- exact Vfexp1.
- exact Vfexp2.
- exact Pxy.
- apply Hexp.
- intros Hf1 Hlxy.
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
  casetype False.
(* Goal: False *)
  now apply (double_round_div_aux0 fexp1 fexp2 _ _ choice1 choice2 Hexp x y).
- intros Hf1 Hlxy.
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
  casetype False.
(* Goal: False *)
  now apply (double_round_div_aux1 fexp1 fexp2 _ _ choice1 choice2 Hexp x y).
- intro H.
  apply double_round_eq_mid_beta_even; try assumption.
(* Goal: Z.le (fexp2 (ln_beta_val beta (Rdiv x y) (Fcore_Raux.ln_beta beta (Rdiv x y)))) (Z.sub (fexp1 (ln_beta_val beta (Rdiv x y) (Fcore_Raux.ln_beta beta (Rdiv x y)))) (Zpos xH)) *)
  apply Hexp.
- intros Hf1 Hlxy.
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
  casetype False.
(* Goal: False *)
  now apply (double_round_div_aux2 fexp1 fexp2 _ _ choice1 choice2 Hexp x y).
Qed.

Lemma double_round_div :
  forall fexp1 fexp2 : Z -> Z,
  Valid_exp fexp1 -> Valid_exp fexp2 ->
  forall (choice1 choice2 : Z -> bool),
  (exists n, (beta = 2 * n :> Z)%Z) ->
  double_round_div_hyp fexp1 fexp2 ->
  forall x y,
  y <> 0 ->
  generic_format beta fexp1 x ->
  generic_format beta fexp1 y ->
  double_round_eq fexp1 fexp2 choice1 choice2 (x / y).
Proof.
(* Goal: forall (fexp1 fexp2 : forall _ : Z, Z) (_ : Valid_exp fexp1) (_ : Valid_exp fexp2) (choice1 choice2 : forall _ : Z, bool) (_ : @ex Z (fun n : Z => @eq Z (radix_val beta) (Z.mul (Zpos (xO xH)) n))) (_ : double_round_div_hyp fexp1 fexp2) (x y : R) (_ : not (@eq R y (IZR Z0))) (_ : generic_format beta fexp1 x) (_ : generic_format beta fexp1 y), double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
intros fexp1 fexp2 Vfexp1 Vfexp2 choice1 choice2 Ebeta Hexp x y Nzy Fx Fy.
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
unfold double_round_eq.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rdiv x y))) (round beta fexp1 (Znearest choice1) (Rdiv x y)) *)
destruct (Rtotal_order x 0) as [Nx|[Zx|Px]].
- (* x < 0 *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rdiv x y))) (round beta fexp1 (Znearest choice1) (Rdiv x y)) *)
  destruct (Rtotal_order y 0) as [Ny|[Zy|Py]].
  + (* y < 0 *)
    rewrite <- (Ropp_involutive x).
    rewrite <- (Ropp_involutive y).
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rdiv (Ropp (Ropp x)) y))) (round beta fexp1 (Znearest choice1) (Rdiv (Ropp (Ropp x)) y)) *)
    rewrite Ropp_div.
    unfold Rdiv; rewrite <- Ropp_inv_permute; [|lra].
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rmult x (Ropp (Rinv (Ropp y)))))) (round beta fexp1 (Znearest choice1) (Rmult x (Ropp (Rinv (Ropp y))))) *)
    rewrite Ropp_mult_distr_r_reverse.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Ropp (Ropp (Rmult (Ropp x) (Rinv (Ropp y))))))) (round beta fexp1 (Znearest choice1) (Ropp (Ropp (Rmult (Ropp x) (Rinv (Ropp y)))))) *)
    rewrite Ropp_involutive.
    fold ((- x) / (- y)).
(* Goal: @eq R (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (round beta fexp2 (Znearest (fun t : Z => negb (choice2 (Z.opp (Z.add t (Zpos xH)))))) (Rdiv (Ropp x) y))) (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (Rdiv (Ropp x) y)) *)
    apply Ropp_lt_contravar in Nx.
(* Goal: @eq R (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (round beta fexp2 (Znearest (fun t : Z => negb (choice2 (Z.opp (Z.add t (Zpos xH)))))) (Rmult x (Rinv (Ropp y))))) (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (Rmult x (Rinv (Ropp y)))) *)
    apply Ropp_lt_contravar in Ny.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rdiv (Ropp x) (Ropp y)))) (round beta fexp1 (Znearest choice1) (Rdiv (Ropp x) (Ropp y))) *)
    rewrite Ropp_0 in Nx, Ny.
(* Goal: @eq R (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (round beta fexp2 (Znearest (fun t : Z => negb (choice2 (Z.opp (Z.add t (Zpos xH)))))) (Rdiv (Ropp x) y))) (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (Rdiv (Ropp x) y)) *)
    apply generic_format_opp in Fx.
(* Goal: @eq R (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (round beta fexp2 (Znearest (fun t : Z => negb (choice2 (Z.opp (Z.add t (Zpos xH)))))) (Rmult x (Rinv (Ropp y))))) (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (Rmult x (Rinv (Ropp y)))) *)
    apply generic_format_opp in Fy.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rdiv x y))) (round beta fexp1 (Znearest choice1) (Rdiv x y)) *)
    now apply double_round_div_aux.
  + (* y = 0 *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rdiv x y))) (round beta fexp1 (Znearest choice1) (Rdiv x y)) *)
    now casetype False; apply Nzy.
  + (* y > 0 *)
    rewrite <- (Ropp_involutive x).
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rdiv (Ropp (Ropp x)) y))) (round beta fexp1 (Znearest choice1) (Rdiv (Ropp (Ropp x)) y)) *)
    rewrite Ropp_div.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Ropp (Rmult x (Rinv (Ropp y)))))) (round beta fexp1 (Znearest choice1) (Ropp (Rmult x (Rinv (Ropp y))))) *)
    do 3 rewrite round_N_opp.
(* Goal: @eq R (Ropp (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (round beta fexp2 (Znearest (fun t : Z => negb (choice2 (Z.opp (Z.add t (Zpos xH)))))) (Rmult x (Rinv (Ropp y)))))) (Ropp (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (Rmult x (Rinv (Ropp y))))) *)
    apply Ropp_eq_compat.
(* Goal: @eq R (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (round beta fexp2 (Znearest (fun t : Z => negb (choice2 (Z.opp (Z.add t (Zpos xH)))))) (Rdiv (Ropp x) y))) (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (Rdiv (Ropp x) y)) *)
    apply Ropp_lt_contravar in Nx.
(* Goal: @eq R (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (round beta fexp2 (Znearest (fun t : Z => negb (choice2 (Z.opp (Z.add t (Zpos xH)))))) (Rdiv (Ropp x) y))) (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (Rdiv (Ropp x) y)) *)
    rewrite Ropp_0 in Nx.
(* Goal: @eq R (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (round beta fexp2 (Znearest (fun t : Z => negb (choice2 (Z.opp (Z.add t (Zpos xH)))))) (Rdiv (Ropp x) y))) (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (Rdiv (Ropp x) y)) *)
    apply generic_format_opp in Fx.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rdiv x y))) (round beta fexp1 (Znearest choice1) (Rdiv x y)) *)
    now apply double_round_div_aux.
- (* x = 0 *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rdiv x y))) (round beta fexp1 (Znearest choice1) (Rdiv x y)) *)
  rewrite Zx.
(* Goal: generic_format beta fexp2 (Rmult (IZR Z0) y) *)
  unfold Rdiv; rewrite Rmult_0_l.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (IZR Z0))) (round beta fexp1 (Znearest choice1) (IZR Z0)) *)
  now rewrite round_0; [|apply valid_rnd_N].
- (* x > 0 *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rdiv x y))) (round beta fexp1 (Znearest choice1) (Rdiv x y)) *)
  destruct (Rtotal_order y 0) as [Ny|[Zy|Py]].
  + (* y < 0 *)
    rewrite <- (Ropp_involutive y).
    unfold Rdiv; rewrite <- Ropp_inv_permute; [|lra].
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rmult x (Ropp (Rinv (Ropp y)))))) (round beta fexp1 (Znearest choice1) (Rmult x (Ropp (Rinv (Ropp y))))) *)
    rewrite Ropp_mult_distr_r_reverse.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Ropp (Rmult x (Rinv (Ropp y)))))) (round beta fexp1 (Znearest choice1) (Ropp (Rmult x (Rinv (Ropp y))))) *)
    do 3 rewrite round_N_opp.
(* Goal: @eq R (Ropp (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (round beta fexp2 (Znearest (fun t : Z => negb (choice2 (Z.opp (Z.add t (Zpos xH)))))) (Rmult x (Rinv (Ropp y)))))) (Ropp (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (Rmult x (Rinv (Ropp y))))) *)
    apply Ropp_eq_compat.
(* Goal: @eq R (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (round beta fexp2 (Znearest (fun t : Z => negb (choice2 (Z.opp (Z.add t (Zpos xH)))))) (Rmult x (Rinv (Ropp y))))) (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (Rmult x (Rinv (Ropp y)))) *)
    apply Ropp_lt_contravar in Ny.
(* Goal: @eq R (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (round beta fexp2 (Znearest (fun t : Z => negb (choice2 (Z.opp (Z.add t (Zpos xH)))))) (Rmult x (Rinv (Ropp y))))) (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (Rmult x (Rinv (Ropp y)))) *)
    rewrite Ropp_0 in Ny.
(* Goal: @eq R (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (round beta fexp2 (Znearest (fun t : Z => negb (choice2 (Z.opp (Z.add t (Zpos xH)))))) (Rmult x (Rinv (Ropp y))))) (round beta fexp1 (Znearest (fun t : Z => negb (choice1 (Z.opp (Z.add t (Zpos xH)))))) (Rmult x (Rinv (Ropp y)))) *)
    apply generic_format_opp in Fy.
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rdiv x y))) (round beta fexp1 (Znearest choice1) (Rdiv x y)) *)
    now apply double_round_div_aux.
  + (* y = 0 *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rdiv x y))) (round beta fexp1 (Znearest choice1) (Rdiv x y)) *)
    now casetype False; apply Nzy.
  + (* y > 0 *)
(* Goal: @eq R (round beta fexp1 (Znearest choice1) (round beta fexp2 (Znearest choice2) (Rdiv x y))) (round beta fexp1 (Znearest choice1) (Rdiv x y)) *)
    now apply double_round_div_aux.
Qed.

Section Double_round_div_FLX.

Import Fcore_FLX.

Variable prec : Z.
Variable prec' : Z.

(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
Context { prec_gt_0_ : Prec_gt_0 prec }.
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
Context { prec_gt_0_' : Prec_gt_0 prec' }.

Lemma FLX_double_round_div_hyp :
  (2 * prec <= prec')%Z ->
  double_round_div_hyp (FLX_exp prec) (FLX_exp prec').
Proof.
(* Goal: forall _ : Z.le (Z.mul (Zpos (xO xH)) prec) prec', double_round_div_hyp (FLX_exp prec) (FLX_exp prec') *)
intros Hprec.
(* Goal: double_round_div_hyp (fun e : Z => if Z.ltb (Z.sub e prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub e prec) (fun e : Z => if Z.ltb (Z.sub e prec') emin' then Z.sub (Z.add emin' prec') (Zpos xH) else Z.sub e prec') *)
unfold Prec_gt_0 in prec_gt_0_.
(* Goal: double_round_div_hyp (FLX_exp prec) (FLX_exp prec') *)
unfold FLX_exp.
(* Goal: double_round_div_hyp (fun e : Z => if Z.ltb (Z.sub e prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub e prec) (fun e : Z => if Z.ltb (Z.sub e prec') emin' then Z.sub (Z.add emin' prec') (Zpos xH) else Z.sub e prec') *)
unfold double_round_div_hyp.
(* Goal: and (forall ex : Z, Z.le (Z.sub ex prec') (Z.sub (Z.sub ex prec) (Zpos xH))) (and (forall (ex ey : Z) (_ : Z.lt (Z.sub ex prec) ex) (_ : Z.lt (Z.sub ey prec) ey) (_ : Z.le (Z.sub (Z.sub ex ey) prec) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.sub (Z.sub ex ey) prec') (Z.sub (Z.sub ex prec) ey)) (and (forall (ex ey : Z) (_ : Z.lt (Z.sub ex prec) ex) (_ : Z.lt (Z.sub ey prec) ey) (_ : Z.le (Z.sub (Z.add (Z.sub ex ey) (Zpos xH)) prec) (Z.add (Z.add (Z.sub ex ey) (Zpos xH)) (Zpos xH))), Z.le (Z.sub (Z.add (Z.sub ex ey) (Zpos xH)) prec') (Z.sub (Z.sub ex prec) ey)) (and (forall (ex ey : Z) (_ : Z.lt (Z.sub ex prec) ex) (_ : Z.lt (Z.sub ey prec) ey) (_ : Z.le (Z.sub (Z.sub ex ey) prec) (Z.sub ex ey)), Z.le (Z.sub (Z.sub ex ey) prec') (Z.sub (Z.add (Z.sub (Z.sub ex ey) prec) (Z.sub ey prec)) ey)) (forall (ex ey : Z) (_ : Z.lt (Z.sub ex prec) ex) (_ : Z.lt (Z.sub ey prec) ey) (_ : @eq Z (Z.sub (Z.sub ex ey) prec) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.sub (Z.sub ex ey) prec') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.sub ey prec)))))) *)
split; [now intro ex; omega|].
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
split; [|split; [|split]]; intros ex ey; omega.
Qed.

Theorem double_round_div_FLX :
  forall choice1 choice2,
  (exists n, (beta = 2 * n :> Z)%Z) ->
  (2 * prec <= prec')%Z ->
  forall x y,
  y <> 0 ->
  FLX_format beta prec x -> FLX_format beta prec y ->
  double_round_eq (FLX_exp prec) (FLX_exp prec') choice1 choice2 (x / y).
Proof.
(* Goal: forall (choice1 choice2 : forall _ : Z, bool) (_ : @ex Z (fun n : Z => @eq Z (radix_val beta) (Z.mul (Zpos (xO xH)) n))) (_ : Z.le (Z.mul (Zpos (xO xH)) prec) prec') (x y : R) (_ : not (@eq R y (IZR Z0))) (_ : FLX_format beta prec x) (_ : FLX_format beta prec y), double_round_eq (FLX_exp prec) (FLX_exp prec') choice1 choice2 (Rdiv x y) *)
intros choice1 choice2 Ebeta Hprec x y Nzy Fx Fy.
(* Goal: double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec') choice1 choice2 (Rdiv x y) *)
apply double_round_div.
- now apply FLX_exp_valid.
- now apply FLX_exp_valid.
- exact Ebeta.
- now apply FLX_double_round_div_hyp.
- exact Nzy.
- now apply generic_format_FLX.
- now apply generic_format_FLX.
Qed.

End Double_round_div_FLX.

Section Double_round_div_FLT.

Import Fcore_FLX.
Import Fcore_FLT.

Variable emin prec : Z.
Variable emin' prec' : Z.

(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
Context { prec_gt_0_ : Prec_gt_0 prec }.
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
Context { prec_gt_0_' : Prec_gt_0 prec' }.

Lemma FLT_double_round_div_hyp :
  (emin' <= emin - prec - 2)%Z ->
  (2 * prec <= prec')%Z ->
  double_round_div_hyp (FLT_exp emin prec) (FLT_exp emin' prec').
Proof.
(* Goal: forall (_ : Z.le (Z.add emin' prec') (Z.sub emin (Zpos xH))) (_ : Z.le (Z.mul (Zpos (xO xH)) prec) prec'), double_round_div_hyp (FTZ_exp emin prec) (FTZ_exp emin' prec') *)
intros Hemin Hprec.
(* Goal: double_round_div_hyp (FLT_exp emin prec) (FLT_exp emin' prec') *)
unfold FLT_exp.
(* Goal: double_round_div_hyp (fun e : Z => if Z.ltb (Z.sub e prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub e prec) (fun e : Z => if Z.ltb (Z.sub e prec') emin' then Z.sub (Z.add emin' prec') (Zpos xH) else Z.sub e prec') *)
unfold Prec_gt_0 in prec_gt_0_.
(* Goal: double_round_div_hyp (fun e : Z => if Z.ltb (Z.sub e prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub e prec) (fun e : Z => if Z.ltb (Z.sub e prec') emin' then Z.sub (Z.add emin' prec') (Zpos xH) else Z.sub e prec') *)
unfold double_round_div_hyp.
(* Goal: and (forall ex : Z, Z.le (if Z.ltb (Z.sub ex prec') emin' then Z.sub (Z.add emin' prec') (Zpos xH) else Z.sub ex prec') (Z.sub (if Z.ltb (Z.sub ex prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub ex prec) (Zpos xH))) (and (forall (ex ey : Z) (_ : Z.lt (if Z.ltb (Z.sub ex prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub ex prec) ex) (_ : Z.lt (if Z.ltb (Z.sub ey prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub ey prec) ey) (_ : Z.le (if Z.ltb (Z.sub (Z.sub ex ey) prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub (Z.sub ex ey) prec) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (if Z.ltb (Z.sub (Z.sub ex ey) prec') emin' then Z.sub (Z.add emin' prec') (Zpos xH) else Z.sub (Z.sub ex ey) prec') (Z.sub (if Z.ltb (Z.sub ex prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub ex prec) ey)) (and (forall (ex ey : Z) (_ : Z.lt (if Z.ltb (Z.sub ex prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub ex prec) ex) (_ : Z.lt (if Z.ltb (Z.sub ey prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub ey prec) ey) (_ : Z.le (if Z.ltb (Z.sub (Z.add (Z.sub ex ey) (Zpos xH)) prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub (Z.add (Z.sub ex ey) (Zpos xH)) prec) (Z.add (Z.add (Z.sub ex ey) (Zpos xH)) (Zpos xH))), Z.le (if Z.ltb (Z.sub (Z.add (Z.sub ex ey) (Zpos xH)) prec') emin' then Z.sub (Z.add emin' prec') (Zpos xH) else Z.sub (Z.add (Z.sub ex ey) (Zpos xH)) prec') (Z.sub (if Z.ltb (Z.sub ex prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub ex prec) ey)) (and (forall (ex ey : Z) (_ : Z.lt (if Z.ltb (Z.sub ex prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub ex prec) ex) (_ : Z.lt (if Z.ltb (Z.sub ey prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub ey prec) ey) (_ : Z.le (if Z.ltb (Z.sub (Z.sub ex ey) prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub (Z.sub ex ey) prec) (Z.sub ex ey)), Z.le (if Z.ltb (Z.sub (Z.sub ex ey) prec') emin' then Z.sub (Z.add emin' prec') (Zpos xH) else Z.sub (Z.sub ex ey) prec') (Z.sub (Z.add (if Z.ltb (Z.sub (Z.sub ex ey) prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub (Z.sub ex ey) prec) (if Z.ltb (Z.sub ey prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub ey prec)) ey)) (forall (ex ey : Z) (_ : Z.lt (if Z.ltb (Z.sub ex prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub ex prec) ex) (_ : Z.lt (if Z.ltb (Z.sub ey prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub ey prec) ey) (_ : @eq Z (if Z.ltb (Z.sub (Z.sub ex ey) prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub (Z.sub ex ey) prec) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (if Z.ltb (Z.sub (Z.sub ex ey) prec') emin' then Z.sub (Z.add emin' prec') (Zpos xH) else Z.sub (Z.sub ex ey) prec') (Z.add (Z.sub (Z.sub ex ey) ey) (if Z.ltb (Z.sub ey prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub ey prec)))))) *)
split; [intro ex|split; [|split; [|split]]; intros ex ey].
- generalize (Zmax_spec (ex - prec') emin').
  generalize (Zmax_spec (ex - prec) emin).
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  omega.
- generalize (Zmax_spec (ex - prec) emin).
  generalize (Zmax_spec (ey - prec) emin).
  generalize (Zmax_spec (ex - ey - prec) emin).
  generalize (Zmax_spec (ex - ey - prec') emin').
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  omega.
- generalize (Zmax_spec (ex - prec) emin).
  generalize (Zmax_spec (ey - prec) emin).
  generalize (Zmax_spec (ex - ey + 1 - prec) emin).
  generalize (Zmax_spec (ex - ey + 1 - prec') emin').
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  omega.
- generalize (Zmax_spec (ex - prec) emin).
  generalize (Zmax_spec (ey - prec) emin).
  generalize (Zmax_spec (ex - ey - prec) emin).
  generalize (Zmax_spec (ex - ey - prec') emin').
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  omega.
- generalize (Zmax_spec (ex - prec) emin).
  generalize (Zmax_spec (ey - prec) emin).
  generalize (Zmax_spec (ex - ey - prec) emin).
  generalize (Zmax_spec (ex - ey - prec') emin').
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  omega.
Qed.

Theorem double_round_div_FLT :
  forall choice1 choice2,
  (exists n, (beta = 2 * n :> Z)%Z) ->
  (emin' <= emin - prec - 2)%Z ->
  (2 * prec <= prec')%Z ->
  forall x y,
  y <> 0 ->
  FLT_format beta emin prec x -> FLT_format beta emin prec y ->
  double_round_eq (FLT_exp emin prec) (FLT_exp emin' prec')
                  choice1 choice2 (x / y).
Proof.
(* Goal: forall (choice1 choice2 : forall _ : Z, bool) (_ : @ex Z (fun n : Z => @eq Z (radix_val beta) (Z.mul (Zpos (xO xH)) n))) (_ : Z.le (Z.add emin' prec') (Z.sub emin (Zpos xH))) (_ : Z.le (Z.mul (Zpos (xO xH)) prec) prec') (x y : R) (_ : not (@eq R y (IZR Z0))) (_ : FTZ_format beta emin prec x) (_ : FTZ_format beta emin prec y), double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec') choice1 choice2 (Rdiv x y) *)
intros choice1 choice2 Ebeta Hemin Hprec x y Nzy Fx Fy.
(* Goal: double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec') choice1 choice2 (Rdiv x y) *)
apply double_round_div.
- now apply FLT_exp_valid.
- now apply FLT_exp_valid.
- exact Ebeta.
- now apply FLT_double_round_div_hyp.
- exact Nzy.
- now apply generic_format_FLT.
- now apply generic_format_FLT.
Qed.

End Double_round_div_FLT.

Section Double_round_div_FTZ.

Import Fcore_FLX.
Import Fcore_FTZ.

Variable emin prec : Z.
Variable emin' prec' : Z.

(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
Context { prec_gt_0_ : Prec_gt_0 prec }.
(* Goal: Rlt (IZR Z0) (Rdiv x y) *)
(* Goal: double_round_eq fexp1 fexp2 choice1 choice2 (Rdiv x y) *)
Context { prec_gt_0_' : Prec_gt_0 prec' }.

Lemma FTZ_double_round_div_hyp :
  (emin' + prec' <= emin - 1)%Z ->
  (2 * prec <= prec')%Z ->
  double_round_div_hyp (FTZ_exp emin prec) (FTZ_exp emin' prec').
Proof.
(* Goal: forall (_ : Z.le (Z.add emin' prec') (Z.sub emin (Zpos xH))) (_ : Z.le (Z.mul (Zpos (xO xH)) prec) prec'), double_round_div_hyp (FTZ_exp emin prec) (FTZ_exp emin' prec') *)
intros Hemin Hprec.
(* Goal: double_round_div_hyp (FTZ_exp emin prec) (FTZ_exp emin' prec') *)
unfold FTZ_exp.
(* Goal: double_round_div_hyp (fun e : Z => if Z.ltb (Z.sub e prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub e prec) (fun e : Z => if Z.ltb (Z.sub e prec') emin' then Z.sub (Z.add emin' prec') (Zpos xH) else Z.sub e prec') *)
unfold Prec_gt_0 in prec_gt_0_.
(* Goal: double_round_div_hyp (fun e : Z => if Z.ltb (Z.sub e prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub e prec) (fun e : Z => if Z.ltb (Z.sub e prec') emin' then Z.sub (Z.add emin' prec') (Zpos xH) else Z.sub e prec') *)
unfold Prec_gt_0 in prec_gt_0_.
(* Goal: double_round_div_hyp (fun e : Z => if Z.ltb (Z.sub e prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub e prec) (fun e : Z => if Z.ltb (Z.sub e prec') emin' then Z.sub (Z.add emin' prec') (Zpos xH) else Z.sub e prec') *)
unfold double_round_div_hyp.
(* Goal: and (forall ex : Z, Z.le (if Z.ltb (Z.sub ex prec') emin' then Z.sub (Z.add emin' prec') (Zpos xH) else Z.sub ex prec') (Z.sub (if Z.ltb (Z.sub ex prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub ex prec) (Zpos xH))) (and (forall (ex ey : Z) (_ : Z.lt (if Z.ltb (Z.sub ex prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub ex prec) ex) (_ : Z.lt (if Z.ltb (Z.sub ey prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub ey prec) ey) (_ : Z.le (if Z.ltb (Z.sub (Z.sub ex ey) prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub (Z.sub ex ey) prec) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (if Z.ltb (Z.sub (Z.sub ex ey) prec') emin' then Z.sub (Z.add emin' prec') (Zpos xH) else Z.sub (Z.sub ex ey) prec') (Z.sub (if Z.ltb (Z.sub ex prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub ex prec) ey)) (and (forall (ex ey : Z) (_ : Z.lt (if Z.ltb (Z.sub ex prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub ex prec) ex) (_ : Z.lt (if Z.ltb (Z.sub ey prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub ey prec) ey) (_ : Z.le (if Z.ltb (Z.sub (Z.add (Z.sub ex ey) (Zpos xH)) prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub (Z.add (Z.sub ex ey) (Zpos xH)) prec) (Z.add (Z.add (Z.sub ex ey) (Zpos xH)) (Zpos xH))), Z.le (if Z.ltb (Z.sub (Z.add (Z.sub ex ey) (Zpos xH)) prec') emin' then Z.sub (Z.add emin' prec') (Zpos xH) else Z.sub (Z.add (Z.sub ex ey) (Zpos xH)) prec') (Z.sub (if Z.ltb (Z.sub ex prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub ex prec) ey)) (and (forall (ex ey : Z) (_ : Z.lt (if Z.ltb (Z.sub ex prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub ex prec) ex) (_ : Z.lt (if Z.ltb (Z.sub ey prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub ey prec) ey) (_ : Z.le (if Z.ltb (Z.sub (Z.sub ex ey) prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub (Z.sub ex ey) prec) (Z.sub ex ey)), Z.le (if Z.ltb (Z.sub (Z.sub ex ey) prec') emin' then Z.sub (Z.add emin' prec') (Zpos xH) else Z.sub (Z.sub ex ey) prec') (Z.sub (Z.add (if Z.ltb (Z.sub (Z.sub ex ey) prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub (Z.sub ex ey) prec) (if Z.ltb (Z.sub ey prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub ey prec)) ey)) (forall (ex ey : Z) (_ : Z.lt (if Z.ltb (Z.sub ex prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub ex prec) ex) (_ : Z.lt (if Z.ltb (Z.sub ey prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub ey prec) ey) (_ : @eq Z (if Z.ltb (Z.sub (Z.sub ex ey) prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub (Z.sub ex ey) prec) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (if Z.ltb (Z.sub (Z.sub ex ey) prec') emin' then Z.sub (Z.add emin' prec') (Zpos xH) else Z.sub (Z.sub ex ey) prec') (Z.add (Z.sub (Z.sub ex ey) ey) (if Z.ltb (Z.sub ey prec) emin then Z.sub (Z.add emin prec) (Zpos xH) else Z.sub ey prec)))))) *)
split; [intro ex|split; [|split; [|split]]; intros ex ey].
- destruct (Z.ltb_spec (ex - prec') emin');
  destruct (Z.ltb_spec (ex - prec) emin);
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  omega.
- destruct (Z.ltb_spec (ex - prec) emin);
  destruct (Z.ltb_spec (ey - prec) emin);
  destruct (Z.ltb_spec (ex - ey - prec) emin);
  destruct (Z.ltb_spec (ex - ey - prec') emin');
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  omega.
- destruct (Z.ltb_spec (ex - prec) emin);
  destruct (Z.ltb_spec (ey - prec) emin);
  destruct (Z.ltb_spec (ex - ey + 1 - prec) emin);
  destruct (Z.ltb_spec (ex - ey + 1 - prec') emin');
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  omega.
- destruct (Z.ltb_spec (ex - prec) emin);
  destruct (Z.ltb_spec (ey - prec) emin);
  destruct (Z.ltb_spec (ex - ey - prec) emin);
  destruct (Z.ltb_spec (ex - ey - prec') emin');
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  omega.
- destruct (Z.ltb_spec (ex - prec) emin);
  destruct (Z.ltb_spec (ey - prec) emin);
  destruct (Z.ltb_spec (ex - ey - prec) emin);
  destruct (Z.ltb_spec (ex - ey - prec') emin');
(* Goal: forall (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.sub (Z.sub ex ey) prec'))) (and (Z.lt (Z.sub (Z.sub ex ey) prec') emin') (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec') emin') emin'))) (_ : or (and (Z.ge (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.sub (Z.sub ex ey) prec))) (and (Z.lt (Z.sub (Z.sub ex ey) prec) emin) (@eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) (Z.sub ey prec))) (and (Z.lt (Z.sub ey prec) emin) (@eq Z (Z.max (Z.sub ey prec) emin) emin))) (_ : or (and (Z.ge (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) (Z.sub ex prec))) (and (Z.lt (Z.sub ex prec) emin) (@eq Z (Z.max (Z.sub ex prec) emin) emin))) (_ : Z.lt (Z.max (Z.sub ex prec) emin) ex) (_ : Z.lt (Z.max (Z.sub ey prec) emin) ey) (_ : @eq Z (Z.max (Z.sub (Z.sub ex ey) prec) emin) (Z.add (Z.sub ex ey) (Zpos xH))), Z.le (Z.max (Z.sub (Z.sub ex ey) prec') emin') (Z.add (Z.sub (Z.sub ex ey) ey) (Z.max (Z.sub ey prec) emin)) *)
  omega.
Qed.

Theorem double_round_div_FTZ :
  forall choice1 choice2,
  (exists n, (beta = 2 * n :> Z)%Z) ->
  (emin' + prec' <= emin - 1)%Z ->
  (2 * prec <= prec')%Z ->
  forall x y,
  y <> 0 ->
  FTZ_format beta emin prec x -> FTZ_format beta emin prec y ->
  double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec')
                  choice1 choice2 (x / y).
Proof.
(* Goal: forall (choice1 choice2 : forall _ : Z, bool) (_ : @ex Z (fun n : Z => @eq Z (radix_val beta) (Z.mul (Zpos (xO xH)) n))) (_ : Z.le (Z.add emin' prec') (Z.sub emin (Zpos xH))) (_ : Z.le (Z.mul (Zpos (xO xH)) prec) prec') (x y : R) (_ : not (@eq R y (IZR Z0))) (_ : FTZ_format beta emin prec x) (_ : FTZ_format beta emin prec y), double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec') choice1 choice2 (Rdiv x y) *)
intros choice1 choice2 Ebeta Hemin Hprec x y Nzy Fx Fy.
(* Goal: double_round_eq (FTZ_exp emin prec) (FTZ_exp emin' prec') choice1 choice2 (Rdiv x y) *)
apply double_round_div.
- now apply FTZ_exp_valid.
- now apply FTZ_exp_valid.
- exact Ebeta.
- now apply FTZ_double_round_div_hyp.
- exact Nzy.
- now apply generic_format_FTZ.
- now apply generic_format_FTZ.
Qed.

End Double_round_div_FTZ.

End Double_round_div.

End Double_round.
