intros p q; elim p; simpl in |- *; auto.
3: case q; simpl in |- *; try intros q1; split; auto;
unfold nat_of_P in |- *; simpl in |- *;
auto with arith.
intros p'; simpl in |- *; case (Pdiv p' q); simpl in |- *;
intros q1 r1 (H1, H2); split.
unfold nat_of_P in |- *; simpl in |- *.
rewrite ZL6; rewrite H1.
case q1; case r1; simpl in |- *.
intros r2 q2. rewrite Z.pos_sub_spec; unfold Pos.compare.
CaseEq (Pcompare (xI r2) q Datatypes.Eq);
simpl in |- *; auto.
intros H3; rewrite <- (Pcompare_Eq_eq _ _ H3); simpl in |- *;
unfold nat_of_P in |- *; simpl in |- *.
apply f_equal with (f := S); repeat rewrite (fun x y => mult_comm x (S y));
repeat rewrite ZL6; unfold nat_of_P in |- *;
simpl in |- *; ring.
intros H3; unfold nat_of_P in |- *; simpl in |- *;
repeat rewrite ZL6; unfold nat_of_P in |- *;
repeat rewrite (fun x y => plus_comm x (S y)); simpl in |- *;
apply f_equal with (f := S); ring.
intros H3; case (Pminus_mask_Gt _ _ H3); intros h (H4, (H5, H6));
unfold Pminus in |- *; rewrite H4.
apply
trans_equal
with
(nat_of_P q + nat_of_P h +
Pmult_nat q2 2 * Pmult_nat q 1);
[ rewrite <- nat_of_P_plus_morphism; rewrite H5; simpl in |- *;
repeat rewrite ZL6; unfold nat_of_P in |- *;
apply f_equal with (f := S)
| unfold nat_of_P in |- * ]; ring.
intros r2. rewrite Z.pos_sub_spec; unfold Pos.compare.
CaseEq (Pcompare 1 q Datatypes.Eq); simpl in |- *; auto.
intros H3; rewrite <- (Pcompare_Eq_eq _ _ H3); simpl in |- *;
repeat rewrite ZL6; unfold nat_of_P in |- *; simpl in |- *;
apply f_equal with (f := S);ring.
intros H3; unfold nat_of_P in |- *; simpl in |- *;
repeat rewrite (fun x y => plus_comm x (S y));
simpl in |- *; apply f_equal with (f := S); repeat rewrite ZL6;
unfold nat_of_P in |- *; simpl in |- *; ring.
intros H3; case (Pminus_mask_Gt _ _ H3); intros h (H4, (H5, H6));
unfold Pminus in |- *; rewrite H4;
apply
trans_equal
with
(nat_of_P q + nat_of_P h +
Pmult_nat r2 2 * Pmult_nat q 1);
[ rewrite <- nat_of_P_plus_morphism; rewrite H5; simpl in |- *;
repeat rewrite ZL6; unfold nat_of_P in |- *;
apply f_equal with (f := S)
| unfold nat_of_P in |- * ]; ring.
intros r2. rewrite Z.pos_sub_spec; unfold Pos.compare.
CaseEq (Pcompare (xI r2) q Datatypes.Eq); simpl in |- *;
auto.
intros H3; rewrite <- (Pcompare_Eq_eq _ _ H3); simpl in |- *;
unfold nat_of_P in |- *; simpl in |- *; repeat rewrite ZL6;
unfold nat_of_P in |- *; apply f_equal with (f := S);
ring.
intros H3; unfold nat_of_P in |- *; simpl in |- *;
repeat rewrite ZL6; unfold nat_of_P in |- *;
apply f_equal with (f := S); ring.
intros H3; case (Pminus_mask_Gt _ _ H3); intros h (H4, (H5, H6));
unfold Pminus in |- *; rewrite H4;
apply trans_equal with (nat_of_P q + nat_of_P h);
[ rewrite <- (nat_of_P_plus_morphism q); rewrite H5;
unfold nat_of_P in |- *; simpl in |- *;
repeat rewrite ZL6; unfold nat_of_P in |- *;
apply f_equal with (f := S)
| unfold nat_of_P in |- * ]; ring.
case q; simpl in |- *; auto.
generalize H2; case q1; case r1; simpl in |- *; auto.
intros r2 q2. rewrite Z.pos_sub_spec; unfold Pos.compare.
CaseEq (Pcompare (xI r2) q Datatypes.Eq);
simpl in |- *; auto.
intros; apply lt_O_nat_of_P; auto.
intros H H0; apply nat_of_P_lt_Lt_compare_morphism; auto.
intros H3 H7; case (Pminus_mask_Gt _ _ H3); intros h (H4, (H5, H6));
unfold Pminus in |- *; rewrite H4;
apply plus_lt_reg_l with (p := nat_of_P q);
rewrite <- (nat_of_P_plus_morphism q); rewrite H5;
unfold nat_of_P in |- *; simpl in |- *; repeat rewrite ZL6;
unfold nat_of_P in |- *;
apply le_lt_trans with (Pmult_nat r2 1 + Pmult_nat q 1);
auto with arith.
intros r2 HH; case q; simpl in |- *; auto.
intros p2; case p2; unfold nat_of_P in |- *; simpl in |- *;
auto with arith.
intros p2; case p2; unfold nat_of_P in |- *; simpl in |- *;
auto with arith.
intros r2 HH. rewrite Z.pos_sub_spec; unfold Pos.compare.
CaseEq (Pcompare (xI r2) q Datatypes.Eq);
simpl in |- *.
intros; apply lt_O_nat_of_P; auto.
intros H3; apply nat_of_P_lt_Lt_compare_morphism; auto.
intros H3; case (Pminus_mask_Gt _ _ H3); intros h (H4, (H5, H6));
unfold Pminus in |- *; rewrite H4;
apply plus_lt_reg_l with (p := nat_of_P q);
rewrite <- (nat_of_P_plus_morphism q); rewrite H5;
unfold nat_of_P in |- *; simpl in |- *; repeat rewrite ZL6;
unfold nat_of_P in |- *;
apply le_lt_trans with (Pmult_nat r2 1 + Pmult_nat q 1);
auto with arith.
intros HH; case q; simpl in |- *; auto.
intros p2; case p2; unfold nat_of_P in |- *; simpl in |- *;
auto with arith.
intros p2; case p2; unfold nat_of_P in |- *; simpl in |- *;
auto with arith.
intros p'; simpl in |- *; case (Pdiv p' q); simpl in |- *;
intros q1 r1 (H1, H2); split.
unfold nat_of_P in |- *; simpl in |- *; rewrite ZL6; rewrite H1.
case q1; case r1; simpl in |- *; auto.
intros r2 q2. rewrite Z.pos_sub_spec; unfold Pos.compare.
CaseEq (Pcompare (xO r2) q Datatypes.Eq);
simpl in |- *; auto.
intros H3; rewrite <- (Pcompare_Eq_eq _ _ H3); simpl in |- *;
unfold nat_of_P in |- *; simpl in |- *; repeat rewrite ZL6;
unfold nat_of_P in |- *; ring.
intros H3; unfold nat_of_P in |- *; simpl in |- *;
repeat rewrite ZL6; unfold nat_of_P in |- *;
ring.
intros H3; case (Pminus_mask_Gt _ _ H3); intros h (H4, (H5, H6));
unfold Pminus in |- *; rewrite H4;
apply
trans_equal
with
(nat_of_P q + nat_of_P h +
Pmult_nat q2 2 * Pmult_nat q 1);
[ rewrite <- (nat_of_P_plus_morphism q); rewrite H5;
unfold nat_of_P in |- *; simpl in |- *;
repeat rewrite ZL6; unfold nat_of_P in |- *
| unfold nat_of_P in |- * ]; ring.
intros H3; unfold nat_of_P in |- *; simpl in |- *;
repeat rewrite ZL6; unfold nat_of_P in |- *;
ring.
intros r2. rewrite Z.pos_sub_spec; unfold Pos.compare.
CaseEq (Pcompare (xO r2) q Datatypes.Eq); simpl in |- *;
auto.
intros H3; rewrite <- (Pcompare_Eq_eq _ _ H3); simpl in |- *;
unfold nat_of_P in |- *; simpl in |- *; repeat rewrite ZL6;
unfold nat_of_P in |- *; ring.
intros H3; unfold nat_of_P in |- *; simpl in |- *;
repeat rewrite ZL6; unfold nat_of_P in |- *;
ring.
intros H3; case (Pminus_mask_Gt _ _ H3); intros h (H4, (H5, H6));
unfold Pminus in |- *; rewrite H4;
apply trans_equal with (nat_of_P q + nat_of_P h);
[ rewrite <- (nat_of_P_plus_morphism q); rewrite H5;
unfold nat_of_P in |- *; simpl in |- *;
repeat rewrite ZL6; unfold nat_of_P in |- *
| unfold nat_of_P in |- * ]; ring.
generalize H2; case q1; case r1; simpl in |- *.
intros r2 q2. rewrite Z.pos_sub_spec; unfold Pos.compare.
CaseEq (Pcompare (xO r2) q Datatypes.Eq);
simpl in |- *; auto.
intros; apply lt_O_nat_of_P; auto.
intros H H0; apply nat_of_P_lt_Lt_compare_morphism; auto.
intros H3 H7; case (Pminus_mask_Gt _ _ H3); intros h (H4, (H5, H6));
unfold Pminus in |- *; rewrite H4;
apply plus_lt_reg_l with (p := nat_of_P q);
rewrite <- (nat_of_P_plus_morphism q); rewrite H5;
unfold nat_of_P in |- *; simpl in |- *;
unfold nat_of_P in |- *; simpl in |- *; repeat rewrite ZL6;
unfold nat_of_P in |- *;
apply lt_trans with (Pmult_nat r2 1 + Pmult_nat q 1);
auto with arith.
intros; apply lt_O_nat_of_P; auto.
intros r2 HH. rewrite Z.pos_sub_spec; unfold Pos.compare.
CaseEq (Pcompare (xO r2) q Datatypes.Eq);
simpl in |- *.
intros; apply lt_O_nat_of_P; auto.
intros H3; apply nat_of_P_lt_Lt_compare_morphism; auto.
intros H3; case (Pminus_mask_Gt _ _ H3); intros h (H4, (H5, H6));
unfold Pminus in |- *; rewrite H4;
apply plus_lt_reg_l with (p := nat_of_P q);
rewrite <- (nat_of_P_plus_morphism q); rewrite H5;
unfold nat_of_P in |- *; simpl in |- *; repeat rewrite ZL6;
unfold nat_of_P in |- *;
apply lt_trans with (Pmult_nat r2 1 + Pmult_nat q 1);
auto with arith.
auto.
Qed.
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.

(* Specifications: *)
Theorem Pdivless1 :
forall bound p q base,
Pcompare bound p Datatypes.Eq = Datatypes.Gt ->
Pdivless bound p base q = (Some _ p, None _, 0).