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.

Lemma P_S : forall (n : nat),
0 <= x -> x < 2 ^ (Z_of_nat (S n) * w) ->
P' M p (fst (foldlz f' (zero_in_Z_, zero_in_Z_) (S n)))
(snd (foldlz f' (zero_in_Z_, zero_in_Z_) (S n))) (x / 2 ^ w) (x_ 0).