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.

Lemma Q_lem : forall (n : nat),
0 <= x -> x < 2 ^ (Z_of_nat n * w) ->
_Z (r''0 M_in_Z_ (* ptM'cM'' *) (foldlz f' (zero_in_Z_, zero_in_Z_) n)) = x mod M.