(****************************************************************************  IEEE754  :  Faux  Laurent Thery  ***************************************************************************** Auxillary properties about natural numbers, relative numbers and reals *)
Require Export Min.
Require Export Arith.
Require Export Reals.
Require Export Zpower.
Require Export ZArith.
Require Export Zcomplements.
Require Export sTactic.
Hint Resolve R1_neq_R0: real.
(*Missing rule for nat *)
intros a b H'.
apply sym_equal.
apply plus_minus; auto.
rewrite plus_comm; apply le_plus_minus; auto.
Qed.
intros p q r t H'; elim H'; simpl in |- *; auto with arith.
elim p; simpl in |- *; auto with arith.
intros n H m H0 H1 H2; apply plus_le_compat; auto with arith.
apply le_trans with (m := r + n * r); auto with arith.
Qed.
Hint Resolve lte_comp_mult: arith.
intros n m H'; rewrite H'; auto.
Qed.
intros n m H'; inversion H'; simpl in |- *; auto.
apply le_trans with (S n); auto.
Qed.
intros p; elim p; simpl in |- *.
auto with arith.
intros n0; case n0.
simpl in |- *; auto with arith.
intros n1 H' q r H'0 H'1.
apply lt_trans with (m := q + S n1 * r); auto with arith.
Qed.
Hint Resolve lt_comp_mult_l: arith.
intros; repeat rewrite (fun x : nat => mult_comm x p); auto with arith.
Qed.
Hint Resolve lt_comp_mult_r: arith.
intros p q r s; case q.
intros H'; inversion H'.
intros q'; case p.
intros H' H'0; simpl in |- *; apply le_lt_trans with (m := r);
auto with arith.
intros p' H' H'0; apply le_lt_trans with (m := S q' * r); auto with arith.
Qed.
Hint Resolve lt_comp_mult: arith.
intros n m p H' H'0.
apply le_antisym; auto.
case (le_or_lt m p); intros H'1; auto with arith.
absurd (n * p < n * m); auto with arith.
rewrite H'0; auto with arith.
case (le_or_lt p m); intros H'1; auto with arith.
absurd (n * m < n * p); auto with arith.
rewrite H'0; auto with arith.
Qed.
Definition natEq : forall n m : nat, {n = m} + {n <> m}.
intros n; elim n.
intros m; case m; auto with arith.
intros n0 H' m; case m; auto with arith.
Defined.
intros n H'; Contradict H'; auto.
rewrite H'; auto with arith.
Qed.
Hint Resolve notEqLt: arith.
intros n m H'; elim H'; auto with arith.
Qed.
intros n m H'; case (le_lt_or_eq _ _ H'); auto with arith.
Qed.
intros n; elim n; simpl in |- *; auto with arith.
intros n' Rec m; case m; simpl in |- *; auto with arith.
intros m'; elim (Rec m'); intros H'0; case H'0; clear H'0; intros H'0 H'1;
rewrite H'0; auto with arith.
Qed.
intros n; elim n; simpl in |- *; auto with arith.
intros n0 H' m; case m; auto with arith.
intros H'0; discriminate.
Qed.
intros n m H'; elim H'; simpl in |- *; auto with arith.
intros m0 H'0 H'1; apply minus_inv_lt_aux; auto.
Qed.
intros m n p q H' H'0.
case (le_or_lt m q); intros H'1.
rewrite minus_inv_lt with (1 := H'1); auto with arith.
apply (fun p n m : nat => plus_le_reg_l n m p) with (p := q).
rewrite le_plus_minus_r; auto with arith.
rewrite (le_plus_minus p q); auto.
rewrite (plus_comm p).
rewrite plus_assoc_reverse.
rewrite le_plus_minus_r; auto with arith.
apply le_trans with (1 := H'); auto with arith.
apply le_trans with (1 := H'0); auto with arith.
apply le_trans with (2 := H'); auto with arith.
Qed.
intros n m p H'; generalize m; clear m; elim H'.
intros m H'0; rewrite <- minus_n_n; elim H'0.
rewrite <- minus_Sn_m; auto with arith.
intros m0 H'1 H'2; rewrite <- minus_Sn_m; auto with arith.
intros m H'0 H'1 m0 H'2; repeat rewrite <- minus_Sn_m; auto with arith.
apply le_trans with n; auto with arith.
Qed.
intros n n1 n2 H' H'0; case (le_or_lt n2 n1); auto.
intros H'1; Contradict H'0; auto.
apply le_not_lt; auto with arith.
Qed.
intros n n1 n2 H' H'0; case (le_or_lt n1 n2); auto.
intros H'1; Contradict H'0; auto.
apply lt_not_le; auto with arith.
Qed.
intros n; case n; simpl in |- *; auto.
Qed.
(*Simplification rules missing in R *)
Hint Resolve Rabs_pos: real.
intros r1 r2 H; replace 0%R with (r1 - r1)%R; unfold Rminus in |- *;
auto with real.
Qed.
Hint Resolve Rlt_Rminus_ZERO: real.
intros a H; case H; intros H1.
apply Rabs_left; auto.
rewrite H1; simpl in |- *; rewrite Rabs_right; auto with real.
Qed.
intros r1 r2; unfold Rmax in |- *; case (Rle_dec r1 r2); auto with real.
Qed.
intros r1 r2; unfold Rmax in |- *; case (Rle_dec r1 r2); auto with real;
intros; apply Ropp_le_cancel; auto with real.
Qed.
intros p q; unfold Rmax in |- *.
case (Rle_dec p q); case (Rle_dec q p); auto; intros H1 H2; apply Rle_antisym;
auto.
case (Rle_or_lt p q); auto; intros H'0; Contradict H1; apply Rlt_le; auto.
case (Rle_or_lt q p); auto; intros H'0; Contradict H2; apply Rlt_le; auto.
Qed.
intros p q r H' H'0; case (Rle_or_lt 0 p); intros H'1.
repeat rewrite Rabs_right; auto with real.
apply Rle_trans with r; auto with real.
apply RmaxLess2; auto.
apply Rge_trans with p; auto with real; apply Rge_trans with q;
auto with real.
apply Rge_trans with p; auto with real.
rewrite (Rabs_left p); auto.
case (Rle_or_lt 0 q); intros H'2.
repeat rewrite Rabs_right; auto with real.
apply Rle_trans with r; auto.
apply RmaxLess2; auto.
apply Rge_trans with q; auto with real.
rewrite (Rabs_left q); auto.
case (Rle_or_lt 0 r); intros H'3.
repeat rewrite Rabs_right; auto with real.
apply Rle_trans with (- p)%R; auto with real.
apply RmaxLess1; auto.
rewrite (Rabs_left r); auto.
apply Rle_trans with (- p)%R; auto with real.
apply RmaxLess1; auto.
Qed.
intros z; case z; simpl in |- *; auto with real.
apply Rabs_right; auto with real.
intros p0; apply Rabs_right; auto with real zarith.
intros p0; unfold IZR; rewrite <- INR_IPR; rewrite Rabs_Ropp.
apply Rabs_right; auto with real zarith.
Qed.
intros p q r H; unfold Rmax in |- *.
case (Rle_dec p q); case (Rle_dec (r * p) (r * q)); auto; intros H1 H2; auto.
case H; intros E1.
case H1; auto with real.
rewrite <- E1; repeat rewrite Rmult_0_l; auto.
case H; intros E1.
case H2; auto with real.
apply Rmult_le_reg_l with (r := r); auto.
rewrite <- E1; repeat rewrite Rmult_0_l; auto.
Qed.
intros p H; rewrite <- Ropp_0; auto with real.
Qed.
intros p H; rewrite <- Ropp_0; auto with real.
Qed.
Hint Resolve Rle_R0_Ropp Rlt_R0_Ropp: real.
(* Properties of Z *)
intros p; elim p.
intros p0 H'; unfold nat_of_P in |- *; simpl in |- *; rewrite ZL6.
generalize H'; case (nat_of_P p0); auto.
intros p0 H'; unfold nat_of_P in |- *; simpl in |- *; rewrite ZL6.
generalize H'; case (nat_of_P p0); simpl in |- *; auto.
unfold nat_of_P in |- *; simpl in |- *; auto with arith.
Qed.
Hint Resolve convert_not_O: zarith arith.
Hint Resolve Zlt_le_weak Zle_not_gt Zgt_irrefl Z.lt_irrefl Zle_not_lt
Zlt_not_le Zlt_asym inj_lt inj_le: zarith.
intros x; elim x; auto.
unfold Z.abs_nat in |- *.
intros p.
pattern p at 1 3 in |- *;
rewrite <- (pred_o_P_of_succ_nat_o_nat_of_P_eq_id p).
generalize (convert_not_O p); case (nat_of_P p); simpl in |- *;
auto with arith.
intros H'; case H'; auto.
intros n H' H'0; rewrite Pos.pred_succ; auto.
intros p H'; Contradict H'; auto.
Qed.
intros p q H'; rewrite H'.
CaseEq (nat_of_P q); simpl in |- *.
elim q; unfold nat_of_P in |- *; simpl in |- *; intros;
try discriminate.
absurd (0%Z = Zpos p0); auto.
red in |- *; intros H'0; try discriminate.
apply H; auto.
change (nat_of_P p0 = 0) in |- *.
generalize H0; rewrite ZL6; case (nat_of_P p0); simpl in |- *;
auto; intros; try discriminate.
intros n; rewrite <- nat_of_P_o_P_of_succ_nat_eq_succ.
intros H'0; apply f_equal with (f := Zpos).
apply nat_of_P_inj; auto.
Qed.
Hint Resolve inj_le inj_lt: zarith.
intros x y H'.
case (le_or_lt x y); auto with arith.
intros H'0; Contradict H'; auto with zarith.
Qed.
intros x y H'; apply le_antisym.
apply ZleLe; auto.
idtac; rewrite H'; auto with zarith.
apply ZleLe; auto.
idtac; rewrite H'; auto with zarith.
Qed.

Theorem Zcompare_EGAL :
forall p q : Z, (p ?= q)%Z = Datatypes.Eq -> p = q.