absurd (c <= x mod M). apply Zlt_not_le. apply Zlt_le_trans with M. apply Zmod_lt_z_m. omega. rewrite c_M. exact le_M_2pp.
assumption. simpl. fold M. elim H0; intro H1. rewrite H1. replace (x mod M + M - M) with (x mod M). rewrite modred. tauto.
apply Zmod_le_0_z. omega. apply Zlt_trans with M. apply Zmod_lt_z_m. omega. unfold M. apply lt_z__Z. ring. rewrite H1.
replace (x mod M + M + M - M) with (x mod M + M). rewrite modred. tauto. apply Zplus_le_0_compat. apply Zmod_le_0_z. omega.
omega. rewrite Zpow_2_w_is_2Zpow_2_wm1. apply Zplus_lt_le_compat. apply Zlt_le_trans with M. apply Zmod_lt_z_m. omega.
assumption. assumption. ring. assumption. rewrite ltw_true. elim r'_i_eq'_i; intro H0. tauto. elim H0; intro H1.
tauto. rewrite H1 in H. absurd (x mod M + M + M <= c). apply Zlt_not_le. cut (c < M + M). cut (0 <= x mod M). omega.
apply Zmod_le_0_z. omega. elim (Zle_lt_or_eq 0 p). intro H2. apply Zlt_le_trans with (2 ^ (p - 1) + 1 + (2 ^ (p - 1) + 1)).
replace (2 ^ (p - 1) + 1 + (2 ^ (p - 1) + 1)) with (2 ^ 1 * 2 ^ (p - 1) + 2). rewrite <- Zpower_exp.
replace (1 + (p - 1)) with p. omega. ring. omega. omega. ring. apply Zplus_le_compat. elim lt_2pm1_M; intro H3. omega.
rewrite H3 in p_M. simpl in p_M. rewrite p_M in H2. absurd (0 < 0); omega. elim lt_2pm1_M; intro H3. omega.
rewrite H3 in p_M. simpl in p_M. rewrite p_M in H2. absurd (0 < 0); omega. intro H2. rewrite c_M. rewrite <- H2. simpl. omega.
unfold p. apply le_0__Z. omega. assumption. Qed.
Let x' := r'a * 2 ^ w + x_i.

(* Specifications: *)
Lemma x_i_eq : x_i = x' mod 2 ^ w.
unfold x'. rewrite Zmod_km_plus. symmetry. unfold x_i. apply modred. apply le_0__Z. apply lt_z__Z. exact lt02w. Qed.
(* <KE EP TOGETHER - s_i_eq *)
Lemma s_i_eq : _Z s_i = x' mod 2 ^ w / 2 ^ p.
simpl. fold l. fold p. fold x_i. rewrite x_i_eq. trivial. Qed.