Section parm_sec.
Variable M_in_Z_ : Z_ (2 ^ w).
Variable ptM' : Z_ w * Z_ w * Z_ (2 ^ w).
Variables v_in_Z_ u_in_Z_ : Z_ (2 ^ w).
Let p_in_Z_w := fst (fst ptM').
Let t_in_Z_w := snd (fst ptM').
Let M'_in_Z_ := snd ptM'.
Let M := _Z M_in_Z_.
Let p := _Z p_in_Z_w.
Let t := _Z t_in_Z_w.
Let M' := _Z M'_in_Z_.
Let v := _Z v_in_Z_.
Let u := _Z u_in_Z_.
Hypothesis le_1_M : 1 <= M.
Hypothesis le_M_max : M <= 2 ^ (w - 1).
Hypothesis p_M : p = Zlog_sup M.
Hypothesis t_M : t = w - p \/ M = 1.
Hypothesis M'_M : M' = 2 ^ (p + w) / M mod 2 ^ w.
Hypothesis v_M : v < 2 ^ p.
Let x := v * 2 ^ w + u.
unfold p. apply le_0__Z. Qed.
unfold u. apply le_0__Z. Qed.
unfold u. apply lt_z__Z. Qed.
unfold v. apply le_0__Z. Qed.
unfold v. apply lt_z__Z. Qed.
apply Zlt_le_weak. exact lt02w. Qed.
Local Hint Resolve le_0_w lt02w le02w : a.
Local Hint Resolve le_0_p le_0_l lt_l_2w le_0_v lt_v_2w : a.
unfold x. fold (0 + 0). apply Zplus_le_compat; auto with a. apply Zmult_le_0_compat; auto with a. Qed.
Local Hint Resolve le_0_x : a.
(* <KEEP TOGETHER - modred_equations *)
Let s := ursh u_in_Z_ p_in_Z_w.
Let s' := multp2 s p_in_Z_w.
Let h := multp2 v_in_Z_ t_in_Z_w.
Let h' := plusw h s.
Let q := uhwm h' M'_in_Z_.
Let q' := plusw q h'.
Let y := multw q' M_in_Z_.
Let d := minusw s' y.
Let r := minusw u_in_Z_ y.
Let r' := ltw d M_in_Z_ r (minusw r M_in_Z_).
Let r'' := ltw r' M_in_Z_ r' (minusw r' M_in_Z_).
Let r''' := ltw r'' M_in_Z_ r'' (minusw r'' M_in_Z_).
(* KEEP TOGETHER> *)
Definition ModRed := _Z r'''. (* keeps _Z out of ModRed_eq *)
unfold x. rewrite Zmod_km_plus. symmetry. apply modred. auto with a. auto with a. auto with a. Qed.
unfold x. rewrite Zdiv_times_plus. rewrite Zdiv_small_0. ring. auto with a. auto with a. auto with a. Qed.
(* KEEP TOGETHER> *)
simpl. fold u. fold p. rewrite l_eq. trivial. Qed.
apply lt_0_Zpow. fold (0 + 0). apply Zplus_le_compat; auto with a. Qed.
apply lt_0_Zpow. auto with a. Qed.
Local Hint Resolve lt_0_2pp : a.
unfold x. apply Z.le_lt_trans with ((2 ^ p - 1) * 2 ^ w + (2 ^ w - 1)). apply Zplus_le_compat.
apply Zmult_le_compat. auto with a. auto with a. cut (v < 2 ^ p). omega. auto with a. omega. auto with a.
auto with a. cut (u < 2 ^ w). omega. auto with a. rewrite Zmult_minus_distr_r. rewrite <- Zpower_exp.
omega. auto with a. apply Z.le_ge. auto with a. apply Z.le_ge. auto with a. Qed.
cut (x < 2 ^ (p + w)). omega. exact lt_x_xmax. Qed.
Local Hint Resolve lt_x_xmax le_x_xmax : a.
cut (0 < w). omega. exact lt_0_w. Qed.
Local Hint Resolve le_0_wm1 lt_0_w : a.
rewrite p_M. apply Z.le_lt_trans with (w - 1). rewrite <- Zlog_sup_pow. apply Zlog_sup_seq.
assumption. auto with a. omega. Qed.
apply Zlt_le_weak. exact lt_p_w. Qed.
cut (p <= w). omega. exact le_p_w. Qed.
Local Hint Resolve lt_p_w le_p_w le_0_wmp : a.
(* KEEP TOGETHER> *)
unfold s'. rewrite Z_from_multp2. fold p. rewrite s_eq. rewrite Zmult_comm. rewrite modred.
replace (x mod 2 ^ p) with (x mod 2 ^ w mod 2 ^ p). apply Zdiv_a_b_b_Zmod. auto with a.
replace (2 ^ w) with (2 ^ (w - p) * 2 ^ p). apply Zmod_prod_Zmod. apply lt_0_Zpow. auto with a.
auto with a. rewrite <- Zpower_exp. apply f_equal2 with (f := Zpower). trivial. ring. apply Z.le_ge.
auto with a. apply Z.le_ge. auto with a. fold (0 * 0). apply Zmult_le_compat. apply Zle_0_div.
apply Zmod_le_0_z. auto with a. auto with a. apply Zlt_le_weak. auto with a. omega. omega.
apply Z.le_lt_trans with (x mod 2 ^ w). rewrite Zmult_comm. apply Z_mult_div_ge. apply Z.lt_gt.
auto with a. apply Zmod_lt_z_m. auto with a. Qed.
(* KEEP TOGETHER> *)
simpl. fold t v. elim t_M; intro H. rewrite H. rewrite <- v_eq. rewrite Zmult_comm. apply modred.
fold (0 * 0). apply Zmult_le_compat. auto with a. apply Zlt_le_weak. apply lt_0_Zpow. auto with a. omega.
omega. apply Z.lt_le_trans with (2 ^ p * 2 ^ (w - p)). apply Zmult_lt_compat_r. auto with a.
apply lt_0_Zpow. auto with a. assumption. rewrite <- Zpower_exp. replace (p + (w - p)) with w. omega.
ring. apply Z.le_ge. auto with a. apply Z.le_ge. auto with a. rewrite H in p_M. simpl in p_M.
rewrite p_M in v_M. replace (2 ^ 0) with 1 in v_M. cut (v = 0). intro H0. unfold x. rewrite H0.
replace (2 ^ t * 0) with 0. simpl. rewrite Zdiv_small_0. simpl. apply modred. omega. auto with a.
auto with a. auto with a. ring. cut (0 <= v). omega. unfold v. apply le_0__Z. ring. Qed.
(* KEEP TOGETHER> *)
unfold h'. rewrite Z_from_plusw. rewrite h_eq. simpl. fold u p. rewrite l_eq. rewrite <- Zdiv_times_plus.
rewrite <- Zmult_assoc. rewrite <- Zpower_exp. replace (w - p + p) with w. rewrite Zdivmod_split.
apply modred. apply Zle_0_div. auto with a. auto with a. apply Z.lt_le_trans with (2 ^ (p + w) / 2 ^ p).
apply Z.le_lt_trans with ((2 ^ (p + w) - 1) / 2 ^ p). apply Zdiv_le. auto with a. cut (x < 2 ^ (p + w)).
omega. auto with a. rewrite Zpower_exp. rewrite Zmult_comm. rewrite Zdiv_mult_minus. rewrite Z_div_mult.
omega. apply Z.lt_gt. auto with a. auto with a. omega. cut (0 < 2 ^ p). omega. auto with a. apply Z.le_ge.
auto with a. apply Z.le_ge. auto with a. rewrite Zpower_exp. rewrite Zmult_comm. rewrite Z_div_mult.
omega. apply Z.lt_gt. auto with a. apply Z.le_ge. auto with a. apply Z.le_ge. auto with a. auto with a.
ring. apply Z.le_ge. auto with a. apply Z.le_ge. auto with a. auto with a. Qed.
(* KEEP TOGETHER> *)
unfold q. rewrite uhwm_eq. rewrite h'_eq. fold M'. rewrite M'_M. trivial. Qed.
rewrite p_M. generalize le_1_M. case M. intro. absurd (2 <= 0); omega. intros q0 H.
elim (Zlog_sup_correct2 (Zpos q0)). omega. omega. intros q0 H. absurd (2 <= Zneg q0). apply Zlt_not_le.
unfold Z.lt. trivial. assumption. Qed.
rewrite p_M. elim (Zle_lt_or_eq 1 M). intro H. left. apply Z.le_trans with (Zlog_sup 2). simpl. omega.
apply Zlog_sup_seq. omega. intro H. right. symmetry. trivial. assumption. Qed.
elim le_1_p; intro H; omega. Qed.
elim lt_0_p; intro H; omega. Qed.
Local Hint Resolve le_M_2pp le_1_p lt_0_p le_0_pm1 : a.
elim (Zle_lt_or_eq 1 M). intro H. rewrite p_M. generalize le_1_M. case M. intro. absurd (2 <= 0); omega.
intros q0 H0. elim (Zlog_sup_correct2 (Zpos q0)). omega. omega. intros q0 H0. absurd (1 <= Zneg q0).
apply Zlt_not_le. unfold Z.lt. trivial. assumption. omega. assumption. Qed.
Local Hint Resolve lt_2pm1_M : a.
elim (Zle_lt_or_eq 1 M). intro H. replace (2 ^ p) with (1 * M + (2 ^ p - M)). apply Zdiv_mult_plus. omega.
cut (M <= 2 ^ p). omega. auto with a. cut (2 ^ p < M + M). omega.
apply Z.lt_le_trans with (2 ^ (p - 1) + 1 + (2 ^ (p - 1) + 1)).
replace (2 ^ (p - 1) + 1 + (2 ^ (p - 1) + 1)) with (2 ^ (p - 1) + 2 ^ (p - 1) + 2). rewrite Z_pow_plus.
replace (p - 1 + 1) with p. omega. ring. elim le_0_pm1. omega. intro H0. absurd (1 < M). omega.
assumption. ring. cut (2 ^ (p - 1) < M). omega. elim lt_2pm1_M. omega. intro H0. absurd (1 < M). omega.
assumption. ring. intro H0. rewrite p_M. rewrite <- H0. trivial. assumption. Qed.
transitivity (2 ^ (p + w) / M / 2 ^ w * 2 ^ w + (2 ^ (p + w) / M) mod 2 ^ w).
apply f_equal2 with (f := Zplus). replace (2 ^ (p + w) / M / 2 ^ w) with 1. ring.
rewrite Zdivdivdiv. rewrite Zmult_comm. rewrite <- Zdivdivdiv. rewrite Zpower_exp; auto with a.
rewrite Z_div_mult. symmetry. exact div_M_1. apply Z.lt_gt. auto with a. apply Z.le_ge. auto with a.
apply Z.le_ge. auto with a. auto with a. omega. omega. auto with a. trivial. apply Zdivmod_split.
auto with a. Qed.
unfold q'. rewrite Z_from_plusw. rewrite q_eq. rewrite h'_eq. rewrite Zplus_comm.
rewrite <- Zdiv_times_plus. rewrite <- Zmult_plus_distr_r. rewrite large_M'_eq. trivial. auto with a. Qed.
intros z a b m H H0. elim H0; intro H1; rewrite H1; tauto. Qed.
(* KEEP TOGETHER> *)
rewrite q'_eq_pre. apply mod_ab_mod. auto with a.
cut (x / 2 ^ p * (2 ^ p * 2 ^ w / M) / 2 ^ w = x / 2 ^ p * 2 ^ p / M - 1 \/
x / 2 ^ p * (2 ^ p * 2 ^ w / M) / 2 ^ w = x / 2 ^ p * 2 ^ p / M).
rewrite Zpower_exp. tauto. apply Z.le_ge. auto with a. apply Z.le_ge. auto with a.
cut (x / 2 ^ p * 2 ^ p / M - 1 <= x / 2 ^ p * (2 ^ p * 2 ^ w / M) / 2 ^ w).
cut (x / 2 ^ p * (2 ^ p * 2 ^ w / M) / 2 ^ w <= x / 2 ^ p * 2 ^ p / M). intros H H0.
elim (Zle_lt_or_eq (x / 2 ^ p * (2 ^ p * 2 ^ w / M) / 2 ^ w) (x / 2 ^ p * 2 ^ p / M)). intro H1. left.
omega. intro H1. right. omega. assumption. apply approx_0_one. omega. auto with a. auto with a.
auto with a. apply approx_m1_one. auto with a. auto with a. omega. auto with a.
cut (x < 2 ^ p * 2 ^ w). cut (0 < 2 ^ p). omega. auto with a. rewrite <- Zpower_exp. auto with a.
apply Z.le_ge. auto with a. apply Z.le_ge. auto with a. Qed.
(* KEEP TOGETHER> *)
unfold y. rewrite Z_from_multw. fold M. elim q'_eq; intro H; rewrite H. left.
rewrite <- Zmod_mult_distr_l. trivial. auto with a. right. rewrite <- Zmod_mult_distr_l.
apply f_equal2 with (f := Zmod). ring. trivial. auto with a. Qed.
unfold M. apply lt_z__Z. Qed.
apply Zlt_le_weak. exact lt_M_2pw. Qed.
Hint Resolve lt_M_2pw le_M_2pw : a.
(* KEEP TOGETHER> *)
unfold d. rewrite Z_from_minusw. rewrite s'_eq. rewrite Zmod_minus_distr_l.
rewrite <- Zmod_minus_distr_l with (b := x mod 2 ^ p). rewrite <- Zmod_minus_distr_l.
rewrite <- Zdiv_a_b_b_Zmod. elim y_eq; intro H. left. rewrite H. rewrite <- Zmod_minus_distr_r.
rewrite Zminus_Zdiv_Zmult. apply modred. apply Zmod_le_0_z. omega. apply Z.lt_le_trans with M.
apply Zmod_lt_z_m. omega. auto with a. omega. auto with a. right. rewrite H.
rewrite <- Zmod_minus_distr_r.
replace (x / 2 ^ p * 2 ^ p - (x / 2 ^ p * 2 ^ p / M * M - M))
with (x / 2 ^ p * 2 ^ p - x / 2 ^ p * 2 ^ p / M * M + M). rewrite Zminus_Zdiv_Zmult. apply modred.
fold (0 + 0). apply Zplus_le_compat. apply Zmod_le_0_z. omega. omega. apply Z.lt_le_trans with (M + M).
apply Zplus_lt_le_compat. apply Zmod_lt_z_m. omega. omega. rewrite Zpow_2_w_is_2Zpow_2_wm1. omega. omega.
ring. auto with a. auto with a. auto with a. auto with a. auto with a. Qed.
(* KEEP TOGETHER> *)
unfold r. unfold d. rewrite Z_from_minusw. rewrite Z_from_minusw. fold u. rewrite s'_eq.
rewrite Zmod_minus_distr_l with (a := x mod 2 ^ w - x mod 2 ^ p).
rewrite <- Zmod_minus_distr_l with (a := x). rewrite <- Zmod_minus_distr_l. rewrite <- Zmod_plus_distr_l.
replace (x - x mod 2 ^ p - _Z y + x mod 2 ^ p) with (x - _Z y). rewrite l_eq. (* explicit coercion needed here *)
rewrite <- Zmod_minus_distr_l. trivial. auto with a. ring. auto with a. auto with a. auto with a.
auto with a. Qed.

(* <KEEP TOGETHER - r'_eq *)
Lemma r'_eq : _Z r' = x / 2 ^ p * 2 ^ p mod M + x mod 2 ^ p.