(* This program is free software; you can redistribute it and/or      *)
(* modify it under the terms of the GNU Lesser General Public License *)
(* as published by the Free Software Foundation; either version 2.1   *)
(* of the License, or (at your option) any later version.             *)
(*                                                                    *)
(* This program is distributed in the hope that it will be useful,    *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of     *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the      *)
(* GNU General Public License for more details.                       *)
(*                                                                    *)
(* You should have received a copy of the GNU Lesser General Public   *)
(* License along with this program; if not, write to the Free         *)
(* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA *)
(* 02110-1301 USA                                                     *)
Require Export Qpositive_sub.
Inductive Q : Set :=
| Zero : Q
| Qpos : Qpositive -> Q
| Qneg : Qpositive -> Q.
Definition Qone := Qpos One.
Definition Qpositive_le_dec :
forall w w' : Qpositive, {Qpositive_le w w'} + {~ Qpositive_le w w'}.
intros w w'; unfold Qpositive_le in |- *; case (Qpositive_le_bool w w'); auto.
Defined.
Ltac Case' f :=
match constr:(f) with
| (Qpositive_le_dec ?X1 ?X2) =>
case f;
[ idtac
| intros Dummy;
generalize (not_Qpositive_le_not_eq _ _ Dummy)
(not_Qpositive_le_Qpositive_le' _ _ Dummy) Dummy;
clear Dummy ]
| _ => case f
end.
Definition Qpositive_eq_dec : forall w w' : Qpositive, {w = w'} + {w <> w'}.
intros w; elim w; intros until w'; case w';
try (auto; right; discriminate; fail);
(intros w'1; elim (H w'1);
[ intros H1; left; rewrite H1; auto
| intros H1; right; red in |- *; intros H2; elim H1; injection H2; auto ]).
Defined.
Definition Qplus (x y : Q) :=
match x, y with
| Qpos x', Qpos y' => Qpos (Qpositive_plus x' y')
| Qpos x', Qneg y' =>
match Qpositive_le_dec x' y' with
| left h =>
match Qpositive_eq_dec x' y' with
| left h => Zero
| right h => Qneg (Qpositive_sub y' x')
end
| right h => Qpos (Qpositive_sub x' y')
end
| Qneg x', Qneg y' => Qneg (Qpositive_plus x' y')
| Qneg x', Qpos y' =>
match Qpositive_le_dec x' y' with
| left h =>
match Qpositive_eq_dec x' y' with
| left h => Zero
| right h => Qpos (Qpositive_sub y' x')
end
| right h => Qneg (Qpositive_sub x' y')
end
| Qneg x', Zero => Qneg x'
| Qpos x', Zero => Qpos x'
| Zero, x => x
end.
Definition Qmult (x y : Q) :=
match x, y with
| Qpos x', Qpos y' => Qpos (Qpositive_mult x' y')
| Qpos x', Qneg y' => Qneg (Qpositive_mult x' y')
| Qneg x', Qpos y' => Qneg (Qpositive_mult x' y')
| Qneg x', Qneg y' => Qpos (Qpositive_mult x' y')
| _, _ => Zero
end.
Definition Qopp (x : Q) :=
match x with
| Zero => Zero
| Qpos x' => Qneg x'
| Qneg x' => Qpos x'
end.
intros a b; case a; case b; simpl in |- *; auto;
try
(intros a' b';
apply f_equal with (f := Qpos) || apply f_equal with (f := Qneg);
apply Qpositive_plus_sym).
intros b' a'; case (Qpositive_le_dec a' b').
case (Qpositive_eq_dec a' b').
case (Qpositive_le_dec b' a').
case (Qpositive_eq_dec b' a').
auto.
intros H; intros; elim H; auto.
intros H H1; intros; elim H; rewrite H1; apply Qpositive_le_refl.
case (Qpositive_le_dec b' a').
case (Qpositive_eq_dec b' a').
intros H H1 H2; elim H2; auto.
intros H; intros; elim H; apply Qpositive_le_antisym; auto.
auto.
case (Qpositive_le_dec b' a').
case (Qpositive_eq_dec b' a').
intros H H1 H2; elim H2; rewrite H; apply Qpositive_le_refl.
auto.
intros H1 H2; elim (Qpositive_le_total a' b'); intros H3;
(elim H1; exact H3) || (elim H2; exact H3).
intros b' a'; case (Qpositive_le_dec a' b'); case (Qpositive_le_dec b' a').
intros H H1; case (Qpositive_eq_dec a' b').
case (Qpositive_eq_dec b' a'); auto.
intros H2 H3; elim H2; auto.
intros H2; elim H2; apply Qpositive_le_antisym; auto.
case (Qpositive_eq_dec a' b'); intros H H1 H2.
elim H1; rewrite H; apply Qpositive_le_refl.
auto.
case (Qpositive_eq_dec b' a').
intros H H1 H2; elim H2; rewrite H; apply Qpositive_le_refl.
auto.
elim (Qpositive_le_total a' b'); intros H;
repeat (intros Dummy; try (elim Dummy; auto; fail); clear Dummy).
Qed.

Theorem Qplus_zero_left : forall n : Q, Qplus Zero n = n.