proposition: Lemma spec_double_divn1_p : forall n r h l, [|r|] < [|b2p|] -> let (q,r') := double_divn1_p n r h l in [|r|] * double_wB w_digits n + ([!n|h!]*2^[|p|] + [!n|l!] / (2^(Zpos(w_digits << n) - [|p|]))) mod double_wB w_digits n = [!n|q!] * [|b2p|] + [|r'|] /\ 0 <= [|r'|] < [|b2p|].
proof: Proof. case (spec_to_Z p); intros HH0 HH1. induction n;intros. simpl (double_divn1_p 0 r h l). unfold double_to_Z, double_wB, "<<". rewrite <- spec_add_mul_divp. exact (spec_div21 (w_add_mul_div p h l) b2p_le H). simpl (double_divn1_p (S n) r h l). unfold double_divn1_p_aux. assert (H1 := spec_split n h);destruct (double_split w_0 n h) as (hh,hl). rewrite H1. rewrite <- double_wB_wwB. assert (H2 := spec_split n l);destruct (double_split w_0 n l) as (lh,ll). rewrite H2. replace ([|r|] * (double_wB w_digits n * double_wB w_digits n) + (([!n|hh!] * double_wB w_digits n + [!n|hl!]) * 2 ^ [|p|] + ([!n|lh!] * double_wB w_digits n + [!n|ll!]) / 2^(Zpos (w_digits << (S n)) - [|p|])) mod (double_wB w_digits n * double_wB w_digits n)) with (([|r|] * double_wB w_digits n + ([!n|hh!] * 2^[|p|] + [!n|hl!] / 2^(Zpos (w_digits << n) - [|p|])) mod double_wB w_digits n) * double_wB w_digits n + ([!n|hl!] * 2^[|p|] + [!n|lh!] / 2^(Zpos (w_digits << n) - [|p|])) mod double_wB w_digits n). generalize (IHn r hh hl H);destruct (double_divn1_p n r hh hl) as (qh,rh); intros (H3,H4);rewrite H3. assert ([|rh|] < [|b2p|]). lia. replace (([!n|qh!] * [|b2p|] + [|rh|]) * double_wB w_digits n + ([!n|hl!] * 2 ^ [|p|] + [!n|lh!] / 2 ^ (Zpos (w_digits << n) - [|p|])) mod double_wB w_digits n) with ([!n|qh!] * [|b2p|] *double_wB w_digits n + ([|rh|]*double_wB w_digits n + ([!n|hl!] * 2 ^ [|p|] + [!n|lh!] / 2 ^ (Zpos (w_digits << n) - [|p|])) mod double_wB w_digits n)). 2:ring. generalize (IHn rh hl lh H0);destruct (double_divn1_p n rh hl lh) as (ql,rl); intros (H5,H6);rewrite H5. split;[rewrite spec_double_WW;trivial;ring|trivial]. assert (Uhh := spec_double_to_Z w_digits w_to_Z spec_to_Z n hh); unfold double_wB,base in Uhh. assert (Uhl := spec_double_to_Z w_digits w_to_Z spec_to_Z n hl); unfold double_wB,base in Uhl. assert (Ulh := spec_double_to_Z w_digits w_to_Z spec_to_Z n lh); unfold double_wB,base in Ulh. assert (Ull := spec_double_to_Z w_digits w_to_Z spec_to_Z n ll); unfold double_wB,base in Ull. unfold double_wB,base. assert (UU:=p_lt_double_digits n). rewrite Zdiv_shift_r;auto with zarith. 2:change (Zpos (w_digits << (S n))) with (2*Zpos (w_digits << n));auto with zarith. replace (2 ^ (Zpos (w_digits << (S n)) - [|p|])) with (2^(Zpos (w_digits << n) - [|p|])*2^Zpos (w_digits << n)). rewrite Zdiv_mult_cancel_r;auto with zarith. rewrite Z.mul_add_distr_r with (p:= 2^[|p|]). pattern ([!n|hl!] * 2^[|p|]) at 2; rewrite (shift_unshift_mod (Zpos(w_digits << n))([|p|])([!n|hl!])); auto with zarith. rewrite Z.add_assoc. replace ([!n|hh!] * 2^Zpos (w_digits << n)* 2^[|p|] + ([!n|hl!] / 2^(Zpos (w_digits << n)-[|p|])* 2^Zpos(w_digits << n))) with (([!n|hh!] *2^[|p|] + double_to_Z w_digits w_to_Z n hl / 2^(Zpos (w_digits << n)-[|p|])) * 2^Zpos(w_digits << n));try (ring;fail). rewrite <- Z.add_assoc. rewrite <- (Zmod_shift_r ([|p|]));auto with zarith. replace (2 ^ Zpos (w_digits << n) * 2 ^ Zpos (w_digits << n)) with (2 ^ (Zpos (w_digits << n) + Zpos (w_digits << n))). rewrite (Zmod_shift_r (Zpos (w_digits << n)));auto with zarith. replace (2 ^ (Zpos (w_digits << n) + Zpos (w_digits << n))) with (2^Zpos(w_digits << n) *2^Zpos(w_digits << n)). rewrite (Z.mul_comm (([!n|hh!] * 2 ^ [|p|] + [!n|hl!] / 2 ^ (Zpos (w_digits << n) - [|p|])))). rewrite Zmult_mod_distr_l by auto with zarith. ring. rewrite Zpower_exp;auto with zarith. assert (0 < Zpos (w_digits << n)). unfold Z.lt;reflexivity. auto with zarith. apply Z_mod_lt;auto with zarith. rewrite Zpower_exp;auto with zarith. split;auto with zarith. apply Zdiv_lt_upper_bound;auto with zarith. rewrite <- Zpower_exp;auto with zarith. replace ([|p|] + (Zpos (w_digits << n) - [|p|])) with (Zpos(w_digits << n));auto with zarith. rewrite <- Zpower_exp;auto with zarith. replace (Zpos (w_digits << (S n)) - [|p|]) with (Zpos (w_digits << n) - [|p|] + Zpos (w_digits << n));trivial. change (Zpos (w_digits << (S n))) with (2*Zpos (w_digits << n)). ring. Qed.
imports: ZArith Ndigits Lia BigNumPrelude DoubleType DoubleBase