intros p n; elim n; simpl in |- *; auto.
intros p0 H.
repeat
rewrite
(fun (x y : positive) (_ : positive -> positive) =>
nat_of_P_mult_morphism x y); simpl in |- *;
auto.
rewrite ZL6; rewrite expPlus; rewrite H; auto.
intros p0 H.
repeat
rewrite
(fun (x y : positive) (_ : positive -> positive) =>
nat_of_P_mult_morphism x y); simpl in |- *;
auto.
rewrite H; rewrite <- expPlus; rewrite <- ZL6; auto.
rewrite mult_comm; simpl in |- *; auto.
Qed.
Fixpoint Pdiv (p q : positive) {struct p} :
Option positive * Option positive :=
match p with
| xH =>
match q with
| xH => (Some _ 1%positive, None _)
| xO r => (None _, Some _ p)
| xI r => (None _, Some _ p)
end
| xI p' =>
match Pdiv p' q with
| (None, None) =>
match (1 - Zpos q)%Z with
| Z0 => (Some _ 1%positive, None _)
| Zpos r' => (Some _ 1%positive, Some _ r')
| Zneg r' => (None _, Some _ 1%positive)
end
| (None, Some r1) =>
match (Zpos (xI r1) - Zpos q)%Z with
| Z0 => (Some _ 1%positive, None _)
| Zpos r' => (Some _ 1%positive, Some _ r')
| Zneg r' => (None _, Some _ (xI r1))
end
| (Some q1, None) =>
match (1 - Zpos q)%Z with
| Z0 => (Some _ (xI q1), None _)
| Zpos r' => (Some _ (xI q1), Some _ r')
| Zneg r' => (Some _ (xO q1), Some _ 1%positive)
end
| (Some q1, Some r1) =>
match (Zpos (xI r1) - Zpos q)%Z with
| Z0 => (Some _ (xI q1), None _)
| Zpos r' => (Some _ (xI q1), Some _ r')
| Zneg r' => (Some _ (xO q1), Some _ (xI r1))
end
end
| xO p' =>
match Pdiv p' q with
| (None, None) => (None _, None _)
| (None, Some r1) =>
match (Zpos (xO r1) - Zpos q)%Z with
| Z0 => (Some _ 1%positive, None _)
| Zpos r' => (Some _ 1%positive, Some _ r')
| Zneg r' => (None _, Some _ (xO r1))
end
| (Some q1, None) => (Some _ (xO q1), None _)
| (Some q1, Some r1) =>
match (Zpos (xO r1) - Zpos q)%Z with
| Z0 => (Some _ (xI q1), None _)
| Zpos r' => (Some _ (xI q1), Some _ r')
| Zneg r' => (Some _ (xO q1), Some _ (xO r1))
end
end
end.
Definition oZ h := match h with
| None => 0
| Some p => nat_of_P p
end.

(* Specifications: *)
Theorem Pdiv_correct :
forall p q,
nat_of_P p =
oZ (fst (Pdiv p q)) * nat_of_P q + oZ (snd (Pdiv p q)) /\
oZ (snd (Pdiv p q)) < nat_of_P q.