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.

(* Specifications: *)
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.
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.
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.
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.
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.
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.
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.
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.
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)).
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.
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.
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.
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.
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.
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.
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.
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.
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)).