Section repeat.
Variable M_in_Z_ : Z_ (2 ^ w).
Variable ptM'cM'' : Z_ w * Z_ w * Z_ (2 ^ w) * Z_ (2 ^ w) * Z_ (2 ^ w).
Variable x : Z. (* multi-word *)
Let p_in_Z_w := fst (fst (fst (fst ptM'cM''))).
Let t_in_Z_w := snd (fst (fst (fst ptM'cM''))).
Let M'_in_Z_ := snd (fst (fst ptM'cM'')).
Let c_in_Z_ := snd (fst ptM'cM'').
Let M''_in_Z_ := snd ptM'cM''.
Let M := _Z M_in_Z_.
Let p := _Z p_in_Z_w.
Let t := _Z t_in_Z_w.
Let c := _Z c_in_Z_.
Let M'' := _Z M''_in_Z_.
Let M' := _Z M'_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 c_M : c = 2 ^ p.
Hypothesis M''_M : M'' = (2 ^ t * M) mod 2 ^ w.
Hypothesis M'_M : M' = 2 ^ (p + w) / M mod 2 ^ w.
Definition x_ (i : nat) := exist (in_Z_ (2 ^ w)) (x / 2 ^ (Z_of_nat i * w) mod 2 ^ w) (mod_in_Z__ (x / 2 ^ (Z_of_nat i * w))).
Definition f' (d_Sir_Si : Z_ (2 ^ w) * Z_ (2 ^ w)) (xi : Z_ (2 ^ w)) :=
(d_i M_in_Z_ ptM'cM'' d_Sir_Si xi, r_i M_in_Z_ ptM'cM'' d_Sir_Si xi).
Fixpoint foldlz (f : Z_ (2 ^ w) * Z_ (2 ^ w) -> Z_ (2 ^ w) -> Z_ (2 ^ w) * Z_ (2 ^ w)) (d_Sir_Si : Z_ (2 ^ w) * Z_ (2 ^ w)) (a:nat) {struct a} :
Z_ (2 ^ w) * Z_ (2 ^ w) :=
match a with
| O   => d_Sir_Si
| S i => foldlz f (f d_Sir_Si (x_ i)) i
end.
intros d r  h l x_i H. unfold f'. unfold M. unfold p. unfold p_in_Z_w. simpl.
apply d_i_r_i_eq; fold p_in_Z_w; fold M; fold p. assumption. omega. assumption.
assumption. assumption. assumption. assumption. assumption. Qed.
intros d r n H.
rewrite Z_div_mod_eq with (a := x / 2 ^ ((Z_of_nat n + 1) * w)) (b := 2 ^ w). rewrite Zdivdivdiv. rewrite <- Zpower_exp.
replace ((Z_of_nat n + 1) * w + w) with ((Z_of_nat n + 2) * w). replace (Z_of_nat n + 1) with (Z_of_nat (S n)).
replace ((x / 2 ^ (Z_of_nat (S n) * w)) mod 2 ^ w) with (_Z (x_ (S n))). rewrite Zmult_comm.
apply P'f'. trivial. trivial. trivial.
trivial. rewrite inj_S. ring. ring. apply Z.le_ge. apply Zmult_le_0_compat. omega. exact le_0_w.
apply Z.le_ge. exact le_0_w. apply lt_0_Zpow. apply Zmult_le_0_compat. omega. exact le_0_w. exact lt02w. apply Z.lt_gt.
exact lt02w. Qed.
induction n. intros d r. intro H.
replace (foldlz f' (d, r) 1) with (f' (d, r) (x_ 0)).
(* replace w with ((Z_of_nat 0 + 1) * w). *) (* does not work *)
cut (P' M p (fst (f' (d, r) (x_ 0))) (snd (f' (d, r) (x_ 0))) (x / 2 ^ ((Z_of_nat 0 + 1) * w)) (x_ 0)). (* workaroud *)
replace ((Z_of_nat 0 + 1) * w) with w. (* works *) trivial. ring. apply P'f'x. assumption. trivial. intros d r. intro H.
replace (foldlz f' (d, r) (S (S n))) with (foldlz f' (f' (d, r) (x_ (S n))) (S n)).
replace (f' (d, r) (x_ (S n))) with (d_i M_in_Z_ ptM'cM'' (d, r) (x_ (S n)), r_i M_in_Z_ ptM'cM'' (d, r) (x_ (S n))). apply IHn.
replace (Z_of_nat n + 2) with (Z_of_nat (S n) + 1).
replace (d_i M_in_Z_ ptM'cM'' (d, r) (x_ (S n))) with (fst (f' (d, r) (x_ (S n)))).
replace (r_i M_in_Z_ ptM'cM'' (d, r) (x_ (S n))) with (snd (f' (d, r) (x_ (S n)))).
apply P'f'x. assumption. trivial. trivial. rewrite inj_S. unfold Z.succ. ring. trivial. trivial. Qed.
intros n H H0. apply P'foldlz. rewrite Zdiv_small_0. simpl. unfold P'. split. left.
replace (_Z (x_ (S n))) with 0. replace (0 mod M) with 0. replace (0 * 2 ^ w + 0) with 0. rewrite Zdiv_small_0.
replace (0 * 2 ^ p) with 0. rewrite modred. trivial. omega. omega. ring. omega. apply lt_0_Zpow. unfold p. unfold p_in_Z_w.
apply le_0_p. trivial. symmetry. apply modred. omega. omega. transitivity (x / 2 ^ (Z_of_nat (S n) * w) mod 2 ^ w).
rewrite Zdiv_small_0. symmetry. apply modred. omega. exact lt02w. assumption. assumption. trivial.
replace (_Z (x_ (S n))) with 0. replace (0 mod 2 ^ p) with 0. simpl. symmetry. apply modred. omega. exact lt02w. symmetry.
apply modred. omega. apply lt_0_Zpow. unfold p. unfold p_in_Z_w. apply le_0_p.
transitivity (x / 2 ^ (Z_of_nat (S n) * w) mod 2 ^ w). rewrite Zdiv_small_0. symmetry. apply modred. omega. exact lt02w.
assumption. assumption. trivial. assumption. apply Z.lt_trans with (2 ^ (Z_of_nat (S n) * w)). assumption. apply Zlt_pow_lt.
apply Zmult_le_0_compat. omega. exact le_0_w. apply Zmult_gt_0_lt_compat_r. apply Z.lt_gt. exact lt_0_w. rewrite inj_S. omega.
Qed.
intros H H0. replace (Z_of_nat 0 * w) with 0 in H0. simpl in H0. cut (x = 0). intro H1. rewrite H1.
rewrite Zdiv_small_0. unfold P'. split. left. simpl. rewrite H1. rewrite Zdiv_small_0. replace (0 * 2 ^ p) with 0. symmetry.
apply modred. omega. omega. ring. rewrite Zdiv_small_0. replace (0 mod 2 ^ w) with 0. omega. symmetry. apply modred. omega.
exact lt02w. omega. omega. rewrite Zdiv_small_0. rewrite modred. apply lt_0_Zpow. unfold p. unfold p_in_Z_w. apply le_0_p.
omega. exact lt02w. omega. omega. simpl. rewrite H1. rewrite Zdiv_small_0. rewrite modred. rewrite modred. symmetry.
apply modred. omega. apply lt_0_Zpow. unfold p. unfold p_in_Z_w. apply le_0_p. apply Zmod_le_0_z. apply lt_0_Zpow. unfold p.
unfold p_in_Z_w. apply le_0_p. rewrite modred with (x := 0). omega. omega. apply lt_0_Zpow. unfold p. unfold p_in_Z_w.
apply le_0_p. apply Zmod_le_0_z. omega. apply Z.lt_le_trans with M. apply Zmod_lt_z_m. omega. rewrite Zpow_2_w_is_2Zpow_2_wm1.
omega. omega. omega. omega. exact lt02w. omega. ring. Qed.
intro n. case n. intros. apply P_O; assumption. intro n0. intros. apply P_S with (n := n0); assumption. Qed.
intros n H H0.
cut (P' M p (fst (foldlz f' (zero_in_Z_, zero_in_Z_) n)) (snd (foldlz f' (zero_in_Z_, zero_in_Z_) n)) (x / 2 ^ w) (x_ 0)).
intro H1. rewrite r''0_eq with (M_in_Z_ := M_in_Z_) (ptM'cM'' := ptM'cM'') (d_Sir_Si := foldlz f' (zero_in_Z_, zero_in_Z_) n)
(l_in_Z_ := x_ 0) (h := x / 2 ^ w). simpl. replace (x / 1) with ((x * 1 + 0) / 1).
rewrite Zdiv_mult_plus. rewrite Zmult_comm. rewrite <- Z_div_mod_eq. trivial. apply Z.lt_gt. exact lt02w. omega. omega. omega.
apply f_equal2 with (f := Z.div); ring. trivial. fold M. omega. trivial. trivial. assumption.
apply P_all; assumption. Qed.
End repeat.
intro M. unfold in_Z_. split. cut (0 < 2 ^ Zlog_sup M). omega. apply lt_0_Zpow. apply Z.le_trans with (Zlog_sup 1).
simpl. omega. apply Zlog_sup_seq. apply Mset_l. apply Zlt_pow_lt. apply Zlog_sup_correct1. case M. unfold in_Mset. simpl.
intros. omega. apply Z.le_lt_trans with (Zlog_sup (2 ^ (w - 1))). apply Zlog_sup_seq. case M. unfold in_Mset. simpl. intros.
omega. rewrite Zlog_sup_pow. omega. cut (0 < w). omega. exact lt_0_w. Qed.
intro M. apply xlex. Qed.
intro M. rewrite <- Zmod_minus_m. symmetry. apply modred; elim (M'ex M); tauto. exact lt02w. Qed.
(* <KE EP TOGETHER - d_n_r_n_def *)
Definition d_n := zero_in_Z_.
Definition r_n := zero_in_Z_.
(* KE EP TOGETHER> *)
Definition MultiRed (M : Z_ (2 ^ w)) (ptM'cM'' : Z_ w * Z_ w * Z_ (2 ^ w) * Z_ (2 ^ w) * Z_ (2 ^ w))
(n : nat) (x : Z_ (2 ^ (Z_of_nat n * w))) :=
g' M (foldlz x (f' M ptM'cM'') (d_n, r_n) n).
(* <KE EP TOGETHER - C'def *)
Definition C' (M : Mset) :=
( C M,
exist (in_Z_ (2 ^ w)) (2 ^ Zlog_sup M)                             (cex M),
exist (in_Z_ (2 ^ w)) (2 ^ (w - Zlog_sup M - 1 / M) * M mod 2 ^ w) (M''ex M)).
(* KE EP TOGETHER> *)

(* <KE EP TOGETHER - multired_equality *)
Theorem MultiRed_eq : forall (M : Mset) (n : nat) (x : Z_ (2 ^ (Z_of_nat n * w))),
_Z (MultiRed M (C' M) n x) = x mod M.