(* 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.

(* Specifications: *)
Theorem Qplus_sym : forall a b : Q, Qplus a b = Qplus b a.
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).