Section bugFix.
Variable
PdivAux :
positive ->
positive -> Option positive * Option positive.
Fixpoint PdivlessAux (bound p base length : positive) {struct length}
: Option positive * Option positive * nat :=
match Pcompare bound p Datatypes.Eq with
| Datatypes.Gt => (Some _ p, None _, 0)
| _ =>
match PdivAux p base with
| (None, None) => (None _, None _, 1)
| (None, Some r1) => (None _, Some _ r1, 1)
| (Some q1, None) =>
match length with
| xH => (Some _ q1, None _, 0)
| xO length' =>
match PdivlessAux bound q1 base length' with
| (s2, None, n) => (s2, None _, S n)
| (s2, Some r2, n) =>
(s2,
Some _
((fun (x : positive)
(_ : positive -> positive)
(y : positive) => (x * y)%positive) r2
(fun x => x) base), S n)
end
| xI length' =>
match PdivlessAux bound q1 base length' with
| (s2, None, n) => (s2, None _, S n)
| (s2, Some r2, n) =>
(s2,
Some _
((fun (x : positive)
(_ : positive -> positive)
(y : positive) => (x * y)%positive) r2
(fun x => x) base), S n)
end
end
| (Some q1, Some r1) =>
match length with
| xH => (Some _ q1, None _, 0)
| xO length' =>
match PdivlessAux bound q1 base length' with
| (s2, None, n) => (s2, Some _ r1, S n)
| (s2, Some r2, n) =>
(s2,
Some _
((fun (x : positive)
(_ : positive -> positive)
(y : positive) => x * y) r2 (
fun x => x) base + r1)%positive,
S n)
end
| xI length' =>
match PdivlessAux bound q1 base length' with
| (s2, None, n) => (s2, Some _ r1, S n)
| (s2, Some r2, n) =>
(s2,
Some _
((fun (x : positive)
(_ : positive -> positive)
(y : positive) => x * y) r2 (
fun x => x) base + r1)%positive,
S n)
end
end
end
end.
End bugFix.
Definition Pdivless := PdivlessAux Pdiv.
intros bound p q base H; case q; simpl in |- *; auto; intros; rewrite H; auto.
Qed.
intros bound p length base; case length; simpl in |- *;
case (Pcompare bound p Datatypes.Eq); auto;
(intros H; case H; auto; fail) || (intros p' H; case H; auto).
Qed.
intros p q; case (Pcompare p q Datatypes.Eq); auto; right; red in |- *;
intros; discriminate.
Qed.
Hint Resolve lt_O_nat_of_P: arith.
intros p; elim p; auto.
intros q; case q; simpl in |- *.
red in |- *; intros; discriminate.
intros q'; rewrite (fun x y => plus_comm x (S y)); simpl in |- *; red in |- *;
intros; discriminate.
intros p' H q; case q.
simpl in |- *; red in |- *; intros; discriminate.
intros q'; red in |- *; intros H0; case (H q').
replace (2 * q') with (2 * S q' - 2).
rewrite <- H0; simpl in |- *; auto.
repeat rewrite (fun x y => plus_comm x (S y)); simpl in |- *; auto.
simpl in |- *; repeat rewrite (fun x y => plus_comm x (S y)); simpl in |- *;
auto.
case q'; simpl in |- *; auto.
Qed.

Theorem Pdivless_correct :
forall bound p q base,
1 < nat_of_P base ->
nat_of_P p <= nat_of_P q ->
nat_of_P p =
oZ (fst (fst (Pdivless bound p base q))) *
exp (nat_of_P base) (snd (Pdivless bound p base q)) +
oZ (snd (fst (Pdivless bound p base q))) /\
(oZ (fst (fst (Pdivless bound p base q))) < nat_of_P bound /\
oZ (snd (fst (Pdivless bound p base q))) <
exp (nat_of_P base) (snd (Pdivless bound p base q))) /\
(forall bound',
nat_of_P bound = nat_of_P base * bound' ->
nat_of_P bound <= nat_of_P p ->
nat_of_P bound <=
nat_of_P base * oZ (fst (fst (Pdivless bound p base q)))).