intros w w' w''; elim (interp_non_zero w); intros p Hex; elim Hex;
intros q Heq; clear Hex.
elim (interp_non_zero w'); intros p' Hex; elim Hex; intros q' Heq'; clear Hex.
elim (interp_non_zero w''); intros p'' Hex; elim Hex; intros q'' Heq'';
clear Hex.
unfold Qpositive_plus in |- *.
rewrite Heq; rewrite Heq'; rewrite Heq''.
elim
(construct_correct2' (S p * S q' + S p' * S q + S q * S q')
(S p * S q' + S p' * S q) (S q * S q')).
intros d;
elim
(interp_non_zero
(Qpositive_c (S p * S q' + S p' * S q) (S q * S q')
(S p * S q' + S p' * S q + S q * S q'))); intros p3 Hex;
elim Hex; intros q3 Heq3; rewrite Heq3; clear Hex.
intros (Heq1, Heq2).
elim
(construct_correct2' (S p' * S q'' + S p'' * S q' + S q' * S q'')
(S p' * S q'' + S p'' * S q') (S q' * S q'')).
intros d';
elim
(interp_non_zero
(Qpositive_c (S p' * S q'' + S p'' * S q') (S q' * S q'')
(S p' * S q'' + S p'' * S q' + S q' * S q'')));
intros p4 Hex; elim Hex; intros q4 Heq6; rewrite Heq6;
clear Hex.
intros (Heq4, Heq5).
apply construct_correct4'.
simpl in |- *; auto with arith.
simpl in |- *; auto with arith.
simpl in |- *; auto with arith.
simpl in |- *; auto with arith.
auto.
auto.
unfold snd, fst in Heq5, Heq1, Heq2, Heq4, Heq5.
apply mult_reg_l with d'.
rewrite mult_plus_distr_r.
rewrite (mult_comm (S d')).
rewrite mult_plus_distr_r.
repeat rewrite mult_assoc_reverse.
rewrite <- Heq5.
rewrite mult_plus_distr_r.
rewrite (mult_comm (S d')).
rewrite mult_plus_distr_r.
rewrite (mult_comm (S p * S q4)).
rewrite (mult_comm (S p4 * S q)).
rewrite (mult_comm (S p4)).
repeat rewrite <- mult_assoc.
rewrite <- Heq5.
rewrite <- Heq4.
rewrite (mult_assoc (S p'')).
rewrite <- (mult_comm (S q3)).
rewrite <- mult_assoc.
apply mult_reg_l with d.
repeat rewrite (mult_comm (S d)); repeat rewrite mult_plus_distr_r;
repeat rewrite <- (mult_comm (S d)); repeat rewrite (mult_assoc (S d));
repeat rewrite (mult_comm (S d)); rewrite <- Heq1;
rewrite <- Heq2.
ring.
simpl in |- *; auto with arith.
simpl in |- *; auto with arith.
auto.
simpl in |- *; auto with arith.
simpl in |- *; auto with arith.
auto.
Qed.
Definition Qpositive_mult (w w' : Qpositive) :=
match Qpositive_i w with
| (p, q) =>
match Qpositive_i w' with
| (p', q') => Qpositive_c (p * p') (q * q') (p * p' + q * q')
end
end.

(* Specifications: *)
Theorem Qpositive_mult_One : forall w : Qpositive, Qpositive_mult One w = w.
intros w; elim (interp_non_zero w); intros p Hex; elim Hex; intros q Heq.