Section mf.
Variable radix : Z.
Hypothesis radixMoreThanOne : (1 < radix)%Z.
Let radixMoreThanZERO := Zlt_1_O _ (Zlt_le_weak _ _ radixMoreThanOne).
Hint Resolve radixMoreThanZERO: zarith.
Let FtoRradix := FtoR radix.
Local Coercion FtoRradix : float >-> R.
Fixpoint maxDiv (v : Z) (p : nat) {struct p} : nat :=
match p with
| O => 0
| S p' =>
match ZdividesP v (Zpower_nat radix p) with
| left _ => p
| right _ => maxDiv v p'
end
end.
intros v p; elim p; simpl in |- *; auto.
intros n H'; case (ZdividesP v (radix * Zpower_nat radix n)); auto.
Qed.
intros v p; case p; simpl in |- *; auto.
intros H'; case H'.
apply Zdivides1.
intros n H'; case (ZdividesP v (radix * Zpower_nat radix n)); auto.
intros H'0; case H'; auto.
intros H'0; generalize (maxDivLess v n); auto with arith.
Qed.
intros v p; elim p.
unfold maxDiv in |- *; rewrite Zpower_nat_O; auto.
apply Zdivides1.
simpl in |- *.
intros n H'; case (ZdividesP v (radix * Zpower_nat radix n)); simpl in |- *;
auto with zarith.
Qed.
intros v p q; elim q.
simpl in |- *; case (ZdividesP v (radix * Zpower_nat radix p)); auto.
intros n H' H'0.
apply H'; auto; clear H'.
simpl in H'0; generalize H'0; clear H'0.
case (ZdividesP v (radix * (radix * Zpower_nat radix (n + p)))).
2: simpl in |- *; auto.
intros H' H'0; Contradict H'0; auto with zarith.
Qed.
intros v p q H' H'0.
apply maxDivSimplAux with (q := q - S p); auto.
replace (S (q - S p + p)) with q; auto with zarith.
Qed.
intros v p q H'; elim q.
simpl in |- *; auto.
intros n; simpl in |- *.
case (ZdividesP v (radix * Zpower_nat radix (n + p))); auto.
case (ZdividesP v (radix * (radix * Zpower_nat radix (n + p)))); auto.
intros H'0 H'1 H'2; Contradict H'2; auto with zarith.
case (ZdividesP v (radix * (radix * Zpower_nat radix (n + p)))); auto.
intros H'0 H'1 H'2; case H'1.
case H'0; intros z1 Hz1; exists (radix * z1)%Z;rewrite Hz1.
unfold Zpower_nat; simpl; ring.
Qed.
intros v p q H' H'0.
replace q with (S (q - S p + p)); auto with zarith.
apply maxDivSimplInvAux; auto.
Qed.
intros v p H'; split.
rewrite H'.
apply maxDivCorrect; auto.
red in |- *; intros H'0; generalize H'; clear H'.
simpl in |- *.
case (ZdividesP v (radix * Zpower_nat radix p)); simpl in |- *; auto.
intros H' H'1; Contradict H'1; auto with zarith.
Qed.
intros v H'.
apply maxDivUnique; auto.
apply maxDivSimpl with (q := digit radix v); auto.
apply maxDivLt; auto.
apply NotDividesDigit; auto.
Qed.
intros v p H' H'0; simpl in |- *.
case (ZdividesP v (radix * Zpower_nat radix p)); auto.
intros H'1; case H'0; simpl in |- *; auto.
intros H'1.
generalize H'; case p; simpl in |- *; auto.
intros n H'2; case (ZdividesP v (radix * Zpower_nat radix n)); auto.
intros H'3; case H'3; auto.
Qed.
intros v p H' H'0 H'1.
apply maxDivSimplInv; auto.
2: apply maxDivUniqueInverse; auto.
apply Zpower_nat_anti_monotone_lt with (n := radix); auto.
apply Z.le_lt_trans with (m := Z.abs v); auto.
rewrite <- (fun x => Z.abs_eq (Zpower_nat radix x)); auto with zarith;
apply ZDividesLe; auto.
apply digitMore; auto.
Qed.
intros v n H.
replace (digit radix v + n) with (digit radix (v * Zpower_nat radix n)); auto.
apply sym_equal.
apply maxDivUniqueInverseDigit; auto.
red in |- *; intros Z1; case (Zmult_integral _ _ Z1); intros Z2.
case H; auto.
absurd (0 < Zpower_nat radix n)%Z; auto with zarith.
rewrite Zpower_nat_is_exp.
repeat rewrite (fun x : Z => Zmult_comm x (Zpower_nat radix n)).
apply ZdividesMult; auto.
case (maxDivUniqueDigit v); auto.
replace (S (maxDiv v (digit radix v) + n)) with
(S (maxDiv v (digit radix v)) + n); auto.
rewrite Zpower_nat_is_exp.
repeat rewrite (fun x : Z => Zmult_comm x (Zpower_nat radix n)).
red in |- *; intros H'.
absurd (Zdivides v (Zpower_nat radix (S (maxDiv v (digit radix v))))).
case (maxDivUniqueDigit v); auto.
apply ZdividesDiv with (p := Zpower_nat radix n); auto with zarith.
apply digitAdd; auto with zarith.
Qed.
Definition LSB (x : float) :=
(Z_of_nat (maxDiv (Fnum x) (Fdigit radix x)) + Fexp x)%Z.
intros x n H'; unfold LSB, Fdigit in |- *; simpl in |- *.
rewrite digitAdd; auto with arith.
rewrite maxDivPlus; auto.
rewrite inj_plus; ring.
Qed.
intros x y H' H'0 H'1.
case (FshiftCorrectSym radix) with (2 := H'1); auto.
intros m1 H'2; elim H'2; intros m2 E; clear H'2.
rewrite (LSB_shift x m1); auto.
rewrite E; auto.
apply sym_equal; apply LSB_shift; auto.
apply (NisFzeroComp radix) with (x := x); auto.
Qed.
intros v p; elim p; simpl in |- *; auto.
intros n H; case (ZdividesP v (radix * Zpower_nat radix n));
case (ZdividesP (- v) (radix * Zpower_nat radix n)); auto.
intros Z1 Z2; case Z1.
case Z2; intros z1 Hz1; exists (- z1)%Z; rewrite Hz1; ring.
intros Z1 Z2; case Z2.
case Z1; intros z1 Hz1; exists (- z1)%Z.
rewrite <- (Z.opp_involutive v); rewrite Hz1; ring.
Qed.
intros x; unfold LSB in |- *; simpl in |- *.
rewrite Fdigit_opp; auto.
rewrite maxDiv_opp; auto.
Qed.
intros v p; elim p; simpl in |- *; auto.
intros n H; case (ZdividesP v (radix * Zpower_nat radix n));
case (ZdividesP (Z.abs v) (radix  * Zpower_nat radix n));
auto.
intros Z1 Z2; case Z1.
case Z2; intros z1 Hz1; exists (Z.abs z1); rewrite Hz1.
rewrite Zabs_Zmult; f_equal. apply Z.abs_eq. auto with zarith.
intros Z1 Z2; case Z2.
case Z1; intros z1 Hz1.
case (Zle_or_lt v 0); intros Z4.
exists (- z1)%Z; rewrite <- (Z.opp_involutive v);
rewrite <- (Zabs_eq_opp v); auto; rewrite Hz1; ring.
exists z1; rewrite <- (Z.abs_eq v); auto with zarith; rewrite Hz1; ring.
Qed.
intros x; unfold LSB in |- *; simpl in |- *.
rewrite Fdigit_abs; auto.
rewrite maxDiv_abs; auto.
Qed.
Definition MSB (x : float) := Z.pred (Z_of_nat (Fdigit radix x) + Fexp x).
intros; unfold MSB, Fshift, Fdigit in |- *; simpl in |- *.
rewrite digitAdd; auto with zarith.
rewrite inj_plus; unfold Z.pred in |- *; ring.
Qed.

Theorem MSB_comp :
forall (x y : float) (n : nat), ~ is_Fzero x -> x = y :>R -> MSB x = MSB y.