Library Float.Expansions.FexpPlus

Require Export Fexp.

Section mf.
Variable radix : Z.
Hypothesis radixMoreThanOne : (1 < radix)%Z.

Let radixMoreThanZERO := Zlt_1_O _ (Zlt_le_weak _ _ radixMoreThanOne).
Hint Resolve radixMoreThanZERO: zarith.

Coercion Local FtoRradix := FtoR radix.
Variable b : Fbound.
Variable precision : nat.
Hypothesis precisionGreaterThanOne : 1 < precision.
Hypothesis pGivesBound : Zpos (vNum b) = Zpower_nat radix precision.
Variable TwoSum : floatfloatfloat × float.
Hypothesis
  TwoSum1 :
     p q : float,
    Fbounded b p
    Fbounded b qClosest b radix (p + q) (fst (TwoSum p q)).
Hypothesis
  TwoSum2 :
     p q : float,
    Fbounded b p
    Fbounded b qsnd (TwoSum p q) = (p + q - fst (TwoSum p q))%R :>R.
Hypothesis
  TwoSum3 :
     p q : float,
    Fbounded b pFbounded b qFbounded b (fst (TwoSum p q)).
Hypothesis
  TwoSum4 :
     p q : float,
    Fbounded b pFbounded b qFbounded b (snd (TwoSum p q)).
Hypothesis
  TwoSumEq1 :
     p q r s : float,
    Fbounded b p
    Fbounded b q
    Fbounded b r
    Fbounded b s
    p = q :>Rr = s :>Rfst (TwoSum p r) = fst (TwoSum q s) :>R.
Hypothesis
  TwoSumEq2 :
     p q r s : float,
    Fbounded b p
    Fbounded b q
    Fbounded b r
    Fbounded b s
    p = q :>Rr = s :>Rsnd (TwoSum p r) = snd (TwoSum q s) :>R.

Fixpoint growExp (p : float) (L : list float) {struct L} :
 list float :=
  match L with
  | nilp :: nil
  | x :: L1match TwoSum p x with
               | (h, c)c :: growExp h L1
               end
  end.

Theorem TwoSumExp :
  p q : float,
 Fbounded b p
 Fbounded b q
 IsExpansion b radix (snd (TwoSum p q) :: fst (TwoSum p q) :: nil).
intros p q H' H'0.
case (Z_zerop (Fnum (snd (TwoSum p q)))); intros Z1.
apply IsExpansionTop1; auto.
apply IsExpansionSingle; auto.
case (Z_zerop (Fnum (fst (TwoSum p q)))); intros Z2.
apply IsExpansionTop2; auto.
apply IsExpansionSingle; auto.
apply IsExpansionTop; auto.
cut
 (snd (TwoSum p q) = Fminus radix (Fplus radix p q) (fst (TwoSum p q)) :>R);
 [ intros Eq1 | idtac ].
rewrite (MSB_comp radix) with (4 := Eq1); auto.
apply (MSBroundLSB b radix precision) with (P := Closest b radix); auto.
apply ClosestRoundedModeP with (precision := precision); auto.
apply (ClosestCompatible b radix (p + q)%R) with (p0 := fst (TwoSum p q));
 auto.
apply sym_eq; apply (Fplus_correct radix); auto with arith.
apply NisFzeroComp with (radix := radix) (x := snd (TwoSum p q)); auto.
rewrite (Fminus_correct radix); auto with arith;
 rewrite (Fplus_correct radix); auto with arith.
apply IsExpansionSingle; auto.
Qed.

Theorem TwoSumOl1 :
  p q : float,
 Fbounded b pFbounded b qis_Fzero qfst (TwoSum p q) = p :>R.
intros p q H' H'0 H'1; generalize (TwoSum1 p q H' H'0); case (TwoSum p q);
 simpl in |- *; auto.
intros f H'2 H'3.
apply sym_eq;
 apply
  (RoundedModeProjectorIdemEq b radix precision) with (P := Closest b radix);
 auto.
apply ClosestRoundedModeP with (precision := precision); auto.
apply (ClosestCompatible b radix) with (1 := H'3); auto.
replace (FtoRradix q) with 0%R; [ unfold FtoRradix in |- *; ring | idtac ].
apply sym_eq; apply (is_Fzero_rep1 radix); auto.
apply
 RoundedModeBounded
  with (radix := radix) (P := Closest b radix) (r := (p + q)%R);
 auto.
apply ClosestRoundedModeP with (precision := precision); auto.
Qed.

Theorem TwoSumOl2 :
  p q : float,
 Fbounded b pFbounded b qis_Fzero qsnd (TwoSum p q) = 0%R :>R.
intros p q H' H'0 H'1; generalize (TwoSumOl1 p q H' H'0 H'1);
 generalize (TwoSum2 p q H' H'0); case (TwoSum p q);
 simpl in |- *; auto.
intros f f0 H'2 H'3.
rewrite H'2.
rewrite H'3.
replace (FtoRradix q) with 0%R; [ unfold FtoRradix in |- *; ring | idtac ].
apply sym_eq; apply (is_Fzero_rep1 radix); auto.
Qed.

Theorem TwoSumOr1 :
  p q : float,
 Fbounded b pFbounded b qis_Fzero pfst (TwoSum p q) = q :>R.
intros p q H' H'0 H'1; generalize (TwoSum1 p q H' H'0); case (TwoSum p q);
 simpl in |- *; auto.
intros f H'2 H'3.
apply sym_eq;
 apply
  (RoundedModeProjectorIdemEq b radix precision) with (P := Closest b radix);
 auto.
apply ClosestRoundedModeP with (precision := precision); auto.
apply (ClosestCompatible b radix) with (1 := H'3); auto.
replace (FtoRradix p) with 0%R; [ unfold FtoRradix in |- *; ring | idtac ].
apply sym_eq; apply (is_Fzero_rep1 radix); auto.
apply
 RoundedModeBounded
  with (radix := radix) (P := Closest b radix) (r := (p + q)%R);
 auto.
apply ClosestRoundedModeP with (precision := precision); auto.
Qed.

Theorem TwoSumOr2 :
  p q : float,
 Fbounded b pFbounded b qis_Fzero psnd (TwoSum p q) = 0%R :>R.
intros p q H' H'0 H'1; generalize (TwoSumOr1 p q H' H'0 H'1);
 generalize (TwoSum2 p q H' H'0); case (TwoSum p q);
 simpl in |- *; auto.
intros f f0 H'2 H'3.
rewrite H'2.
rewrite H'3.
replace (FtoRradix p) with 0%R; [ unfold FtoRradix in |- *; ring | idtac ].
apply sym_eq; apply (is_Fzero_rep1 radix); auto.
Qed.

Theorem growExpIsVal :
  L : list float,
 IsExpansion b radix L
  p : float,
 Fbounded b pexpValue radix (growExp p L) = (p + expValue radix L)%R :>R.
intros L; elim L.
simpl in |- *; auto.
intros H' p H'0; rewrite (Fplus_correct radix); auto with arith.
intros a l H' H'0 p H'1; simpl in |- ×.
CaseEq (TwoSum p a).
intros f f0 H'2; simpl in |- ×.
repeat rewrite (Fplus_correct radix); auto with arith.
rewrite H'.
repeat rewrite <- Rplus_assoc.
cut (Fbounded b a);
 [ intros Fb1 | apply (expBoundedInv b radix) with (L := l) ];
 auto.
generalize (TwoSum2 _ _ H'1 Fb1); rewrite H'2; simpl in |- ×.
unfold FtoRradix in |- *; intros H'3; rewrite H'3; ring; ring.
apply expInv with (a := a); auto.
cut (Fbounded b a);
 [ intros Fb1 | apply (expBoundedInv b radix) with (L := l) ];
 auto.
generalize (TwoSum3 _ _ H'1 Fb1); rewrite H'2; simpl in |- *; auto.
Qed.

Theorem IsExpansionCons :
  L : list float,
 IsExpansion b radix L
  p : float,
 ¬ is_Fzero p
 Fbounded b p
 ( q : float, In q L¬ is_Fzero q → (MSB radix p < LSB radix q)%Z) →
 IsExpansion b radix (p :: L).
intros L; elim L.
intros H' p H'0 H'1 H'2; apply IsExpansionSingle; auto.
intros a l H' H'0 p H'1 H'2 H'3.
case (is_FzeroP a); intros Z1.
apply IsExpansionTop2; auto.
apply expBoundedInv with (radix := radix) (L := l); auto.
apply H'; auto.
apply expInv with (a := a); auto.
intros q H'4 H'5; apply H'3; auto.
simpl in |- *; auto.
apply IsExpansionTop; auto.
apply expBoundedInv with (radix := radix) (L := l); auto.
apply H'3; auto with datatypes.
Qed.

Theorem IsExpansionConsInvAux :
  L : list float,
 IsExpansion b radix L
  (L' : list float) (p q : float),
 ¬ is_Fzero p
 L = p :: L'In q L'¬ is_Fzero q → (MSB radix p < LSB radix q)%Z.
intros L H'; elim H'; auto.
intros L' p q H'0 H'1; discriminate.
intros x H'0 L' p q H'1 H'2; inversion H'2; simpl in |- ×.
intros H'3; elim H'3.
intros x L0 H'0 H'1 H'2 H'3 L' p q H'4 H'5; inversion H'5; auto.
case H'4; rewrite <- H0; auto.
intros x y L0 H'0 H'1 H'2 H'3 H'4 L' p q H'5 H'6; inversion H'6.
simpl in |- *; auto.
intros H'7 H'8; case H'7; intros H'9.
case H'8; rewrite <- H'9; auto.
apply H'4 with (L' := L0); auto.
rewrite H0; auto.
intros x y L0 H'0 H'1 H'2 H'3 H'4 H'5 H'6 L' p q H'7 H'8; inversion H'8; auto.
simpl in |- *; auto.
intros H'9 H'10; case H'9; intros H'11.
rewrite <- H'11; rewrite <- H0; auto.
apply Zlt_trans with (LSB radix y); auto.
rewrite <- H0; auto.
apply Zle_lt_trans with (MSB radix y); auto.
apply LSB_le_MSB; auto.
apply H'6 with (L' := L0); auto.
Qed.

Theorem IsExpansionConsInv :
  (L : list float) (p q : float),
 ¬ is_Fzero p
 IsExpansion b radix (p :: L) →
 In q L¬ is_Fzero q → (MSB radix p < LSB radix q)%Z.
intros L p q H' H'0 H'1 H'2.
apply IsExpansionConsInvAux with (L := p :: L) (L' := L); auto.
Qed.

Theorem IsExpansionSkip :
  (L : list float) (p q : float),
 IsExpansion b radix (p :: q :: L) → IsExpansion b radix (p :: L).
intros L p q H'.
case (is_FzeroP p); intros Z1.
apply IsExpansionTop1; auto.
apply expBoundedInv with (radix := radix) (L := q :: L); auto.
apply expInv with (a := q); auto.
apply expInv with (a := p); auto.
apply IsExpansionCons; auto.
apply expInv with (a := q); auto.
apply expInv with (a := p); auto.
apply expBoundedInv with (radix := radix) (L := q :: L); auto.
intros q0 H'0 H'1.
apply IsExpansionConsInv with (L := q :: L); auto with datatypes.
Qed.

Theorem TwoSumLt1 :
  p q : float,
 Fbounded b p
 Fbounded b q
 ¬ is_Fzero p
 ¬ is_Fzero q
 ¬ is_Fzero (fst (TwoSum p q)) →
 (Zmin (LSB radix p) (LSB radix q) LSB radix (fst (TwoSum p q)))%Z.
intros p q H'0 H'1 H'2 H'3 H'4.
apply Zle_trans with (LSB radix (Fplus radix p q)); auto.
case (LSB_rep_min radix radixMoreThanOne p); auto; intros p' Hp'.
case (LSB_rep_min radix radixMoreThanOne q); auto; intros q' Hq'.
apply LSBPlus; auto.
Contradict H'4; auto.
apply (is_Fzero_rep2 radix); auto.
rewrite <- (FzeroisZero radix b); auto.
apply sym_eq;
 apply
  RoundedModeProjectorIdemEq
   with (b := b) (precision := precision) (P := Closest b radix);
 auto.
apply ClosestRoundedModeP with (precision := precision); auto.
apply FboundedFzero; auto.
apply (ClosestCompatible b radix) with (1 := TwoSum1 _ _ H'0 H'1); auto.
rewrite (FzeroisZero radix b); auto.
replace 0%R with (FtoRradix (Fplus radix p q)); auto.
rewrite (Fplus_correct radix); auto with arith.
apply (is_Fzero_rep1 radix); auto.
repeat rewrite (Fplus_correct radix); auto with arith.
apply
 RoundLSBMax with (b := b) (precision := precision) (P := Closest b radix);
 auto.
apply ClosestRoundedModeP with (precision := precision); auto.
apply (ClosestCompatible b radix) with (1 := TwoSum1 _ _ H'0 H'1); auto.
rewrite Fplus_correct; auto with arith.
Qed.

Theorem TwoSumLt2 :
  p q : float,
 Fbounded b p
 Fbounded b q
 ¬ is_Fzero p
 ¬ is_Fzero q
 ¬ is_Fzero (snd (TwoSum p q)) →
 (Zmin (LSB radix p) (LSB radix q) LSB radix (snd (TwoSum p q)))%Z.
intros p q H' H'0 H'1 H'2 H'3.
case (is_FzeroP (fst (TwoSum p q))); intros Z1.
cut (snd (TwoSum p q) = Fplus radix p q :>R); [ intros Eq1 | idtac ].
replace (LSB radix (snd (TwoSum p q))) with (LSB radix (Fplus radix p q));
 auto.
apply LSBPlus; auto.
apply (NisFzeroComp radix) with (3 := Eq1); auto.
apply LSB_comp; auto.
apply (NisFzeroComp radix) with (3 := Eq1); auto.
rewrite TwoSum2; auto.
unfold FtoRradix in |- *; rewrite (is_Fzero_rep1 radix) with (1 := Z1); auto.
rewrite Fplus_correct; auto with arith; ring.
cut
 (snd (TwoSum p q) = Fminus radix (Fplus radix p q) (fst (TwoSum p q)) :>R);
 [ intros Eq1 | idtac ].
replace (LSB radix (snd (TwoSum p q))) with
 (LSB radix (Fminus radix (Fplus radix p q) (fst (TwoSum p q)))).
apply
 Zle_trans
  with (Zmin (LSB radix (Fplus radix p q)) (LSB radix (fst (TwoSum p q))));
 auto.
apply Zmin_Zle; auto.
apply LSBPlus; auto.
Contradict Z1; auto.
apply (is_Fzero_rep2 radix); auto.
rewrite <- (FzeroisZero radix b); auto.
apply sym_eq;
 apply
  RoundedModeProjectorIdemEq
   with (b := b) (precision := precision) (P := Closest b radix);
 auto.
apply ClosestRoundedModeP with (precision := precision); auto.
apply FboundedFzero; auto.
apply (ClosestCompatible b radix) with (1 := TwoSum1 _ _ H' H'0); auto.
rewrite (FzeroisZero radix b); auto.
replace 0%R with (FtoRradix (Fplus radix p q)); auto.
rewrite (Fplus_correct radix); auto with arith.
apply (is_Fzero_rep1 radix); auto.
apply TwoSumLt1; auto.
apply LSBMinus; auto.
apply (NisFzeroComp radix) with (3 := Eq1); auto.
apply LSB_comp; auto.
apply (NisFzeroComp radix) with (3 := Eq1); auto.
rewrite TwoSum2; auto.
rewrite (Fminus_correct radix); auto with arith;
 rewrite (Fplus_correct radix); auto with arith.
Qed.

Theorem IsExpansionGrowConsInvAux :
  L : list float,
 IsExpansion b radix L
  (L' : list float) (p q r : float),
 Fbounded b r
 ¬ is_Fzero p
 L = p :: L'
 In q (growExp r L') →
 ¬ is_Fzero q
 (is_Fzero r → (MSB radix p < LSB radix q)%Z)
 (¬ is_Fzero r
  (MSB radix p < LSB radix q)%Z (LSB radix r LSB radix q)%Z).
intros L H'; elim H'; simpl in |- *; auto.
intros L' p q r H'0 H'1 H'2; discriminate.
intros x H'0 L' p q r H'1 H'2 H'3; inversion H'3; simpl in |- *; auto.
intros H'4 H'5; split; case H'4.
intros H'6 H'7; case H'5; rewrite <- H'6; auto.
intros H'6; elim H'6; auto.
intros H'6; rewrite <- H'6; auto with zarith.
intros H'6; elim H'6.
intros x L0 H'0 H'1 H'2 H'3 L' p q r H'4 H'5 H'6; inversion H'6; auto.
case H'5; rewrite <- H0; auto.
intros x y L0 H'0 H'1 H'2 H'3 H'4 L' p q r H'5 H'6 H'7; inversion H'7.
simpl in |- ×.
CaseEq (TwoSum r y); simpl in |- *; auto.
intros f f0 H'8 H'9; elim H'9; intros H'10.
intros H'11; case H'11; rewrite <- H'10.
apply (is_Fzero_rep2 radix); auto.
replace (FtoR radix f0) with (FtoRradix (snd (TwoSum r y))); auto.
apply TwoSumOl2; auto.
rewrite H'8; auto.
split.
intros H'11.
case (H'4 L0 p q f); auto.
replace f with (fst (TwoSum r y)); auto.
rewrite H'8; auto.
rewrite <- H0; auto.
intros H'12 H'13; apply H'12; auto.
replace f with (fst (TwoSum r y)); auto.
apply (is_Fzero_rep2 radix); auto.
replace 0%R with (FtoRradix r).
apply TwoSumOl1; auto.
apply (is_Fzero_rep1 radix); auto.
rewrite H'8; auto.
intros H'11.
case (H'4 L0 p q f); auto.
replace f with (fst (TwoSum r y)); auto.
rewrite H'8; auto.
rewrite <- H0; auto.
intros H'13 H'14.
case (is_FzeroP f); intros Z1; auto.
replace (LSB radix r) with (LSB radix f); auto.
apply LSB_comp; auto.
replace f with (fst (TwoSum r y)); auto.
apply TwoSumOl1; auto.
rewrite H'8; auto.
intros x y L0 H'0 H'1 H'2 H'3 H'4 H'5 H'6 L' p q r H'7 H'8 H'9; inversion H'9.
simpl in |- *; auto.
CaseEq (TwoSum r y); simpl in |- *; auto.
intros f f0 H'10 H'11; case H'11; intros H'12.
rewrite <- H'12; auto.
intros H'13; split; auto.
intros H'14; case H'13.
replace f0 with (snd (TwoSum r y)); auto.
apply (is_Fzero_rep2 radix); auto.
apply TwoSumOr2; auto.
rewrite H'10; auto.
intros H'14.
cut (Zmin (LSB radix r) (LSB radix y) LSB radix (snd (TwoSum r y)))%Z.
rewrite H'10; simpl in |- *; auto.
unfold Zmin in |- *; case (LSB radix r ?= LSB radix y)%Z; auto.
intros H'15; left; apply Zlt_le_trans with (LSB radix y); auto.
rewrite <- H0; auto.
apply TwoSumLt2; auto.
rewrite H'10; auto.
intros H'13.
case (H'6 L0 y q f); auto.
replace f with (fst (TwoSum r y)); auto.
rewrite H'10; auto.
intros H'14 H'15; split.
intros H'16.
case H'15; auto.
apply (NisFzeroComp radix) with (2 := H'1); auto.
replace f with (fst (TwoSum r y)); auto.
apply sym_eq; apply TwoSumOr1; auto.
rewrite H'10; auto.
intros H'17; apply Zlt_trans with (LSB radix y).
rewrite <- H0; auto.
apply Zle_lt_trans with (MSB radix y); auto.
apply LSB_le_MSB; auto.
intros H'17; apply Zlt_le_trans with (LSB radix y).
rewrite <- H0; auto.
replace (LSB radix y) with (LSB radix f); auto.
apply sym_equal; apply LSB_comp; auto.
replace f with (fst (TwoSum r y)); auto.
apply sym_eq; apply TwoSumOr1; auto.
rewrite H'10; auto.
intros H'16; case (is_FzeroP f); intros Z1.
left; apply Zlt_trans with (LSB radix y); auto.
rewrite <- H0; auto.
apply Zle_lt_trans with (MSB radix y); auto.
apply LSB_le_MSB; auto.
case H'15; auto; intros H'17.
left; apply Zlt_trans with (LSB radix y); auto.
rewrite <- H0; auto.
apply Zle_lt_trans with (MSB radix y); auto.
apply LSB_le_MSB; auto.
cut (Zmin (LSB radix r) (LSB radix y) LSB radix (fst (TwoSum r y)))%Z.
rewrite H'10; simpl in |- *; auto.
unfold Zmin in |- *; case (LSB radix r ?= LSB radix y)%Z; auto.
intros H'18; right; apply Zle_trans with (1 := H'18); auto.
intros H'18; right; apply Zle_trans with (1 := H'18); auto.
intros H'18; left; apply Zlt_le_trans with (LSB radix y).
rewrite <- H0; auto.
apply Zle_trans with (1 := H'18); auto.
apply TwoSumLt1; auto.
rewrite H'10; auto.
Qed.

Theorem growExpIsExp :
  L : list float,
 IsExpansion b radix L
  p : float, Fbounded b pIsExpansion b radix (growExp p L).
intros L; elim L; simpl in |- *; auto.
intros H' p H'0.
apply IsExpansionSingle; auto.
intros a l H' H'0 p H'1; CaseEq (TwoSum p a); auto.
intros f f0 H'2.
cut (Fbounded b a);
 [ intros Fba | apply (expBoundedInv b radix) with (L := l) ];
 auto.
case (is_FzeroP f0); intros Z1.
apply IsExpansionTop1; auto.
replace f0 with (snd (TwoSum p a)); auto.
rewrite H'2; auto.
apply H'; auto.
apply expInv with (a := a); auto.
replace f with (fst (TwoSum p a)); auto.
rewrite H'2; auto.
apply IsExpansionCons; auto.
apply H'; auto.
apply expInv with (a := a); auto.
replace f with (fst (TwoSum p a)); auto.
rewrite H'2; auto.
replace f0 with (snd (TwoSum p a)); auto.
rewrite H'2; auto.
intros q H'3 H'4.
cut (IsExpansion b radix (f0 :: l)); [ intros IsE1 | idtac ].
case (IsExpansionGrowConsInvAux (f0 :: l) IsE1 l f0 q f); auto.
replace f with (fst (TwoSum p a)); auto.
rewrite H'2; auto.
intros H'5 H'6.
case (is_FzeroP f); intros Z2; auto.
case H'6; auto.
intros H'7; apply Zlt_le_trans with (2 := H'7).
generalize (TwoSumExp p a H'1 Fba); rewrite H'2; simpl in |- *; intros IsE2;
 inversion IsE2; auto.
case Z1; auto.
case Z2; auto.
apply IsExpansionCons; auto.
apply expInv with (a := a); auto.
replace f0 with (snd (TwoSum p a)); auto.
rewrite H'2; auto.
intros q0 H'5 H'6.
apply Zle_lt_trans with (MSB radix a).
apply MSB_monotone; auto.
Contradict Z1.
apply (is_Fzero_rep2 radix); auto.
replace f0 with (snd (TwoSum p a)); auto.
apply TwoSumOl2; auto.
rewrite H'2; auto.
repeat rewrite Fabs_correct; auto with arith.
replace f0 with (snd (TwoSum p a)); auto.
rewrite TwoSum2; auto.
replace (FtoR radix a) with (p + a - p)%R;
 [ idtac | unfold FtoRradix in |- *; ring ].
cut ( x y : R, Rabs (x - y) = Rabs (y - x));
 [ intros Re1; repeat rewrite (Re1 (p + a)%R)
 | intros x y; rewrite <- (Ropp_minus_distr x); rewrite Rabs_Ropp; auto ].
case (TwoSum1 _ _ H'1 Fba); auto.
rewrite H'2; auto.
apply IsExpansionConsInv with (L := l); auto.
Contradict Z1.
apply (is_Fzero_rep2 radix); auto.
replace f0 with (snd (TwoSum p a)); auto.
apply TwoSumOl2; auto.
rewrite H'2; auto.
Qed.

Fixpoint addExp (L1 L2 : list float) {struct L1} :
 list float :=
  match L1 with
  | nilL2
  | x :: L'1
      match growExp x L2 with
      | nilL'1
      | y :: L'2y :: addExp L'1 L'2
      end
  end.

Theorem addExpIsVal :
  L1 L2 : list float,
 IsExpansion b radix L1
 IsExpansion b radix L2
 expValue radix (addExp L1 L2) = (expValue radix L1 + expValue radix L2)%R
 :>R.
intros L1; elim L1; simpl in |- *; auto.
intros L2 HL1 HL2; replace (FtoRradix (Fzero 0)) with 0%R;
 [ ring
 | apply sym_eq; apply (is_Fzero_rep1 radix); red in |- *; simpl in |- × ];
 auto.
intros a l Rec L2 HL1 HL2.
cut (Fbounded b a);
 [ intros Fba | apply (expBoundedInv b radix) with (L := l) ];
 auto.
generalize (growExpIsVal L2 HL2 a Fba);
 generalize (growExpIsExp L2 HL2 a Fba); case (growExp a L2);
 simpl in |- *; auto.
intros H' H'0; rewrite (Fplus_correct radix); auto with zarith.
replace (FtoR radix a + FtoR radix (expValue radix l) + expValue radix L2)%R
 with (a + expValue radix L2 + expValue radix l)%R;
 [ idtac | unfold FtoRradix in |- *; ring ].
rewrite <- H'0; auto.
replace (FtoRradix (Fzero 0)) with 0%R;
 [ ring
 | apply sym_eq; apply (is_Fzero_rep1 radix); red in |- *; simpl in |- × ];
 auto.
intros f l0 H' H'0; repeat rewrite (Fplus_correct radix); auto with zarith.
rewrite Rec; auto.
replace (FtoR radix a + FtoR radix (expValue radix l) + expValue radix L2)%R
 with (a + expValue radix L2 + expValue radix l)%R;
 [ idtac | unfold FtoRradix in |- *; ring ].
rewrite <- H'0; repeat rewrite (Fplus_correct radix); auto with zarith.
unfold FtoRradix in |- *; ring.
apply expInv with (a := a); auto.
apply expInv with (a := f); auto.
Qed.

Theorem IsExpansionAddInv :
  (L1 L2 : list float) (p q : float),
 ¬ is_Fzero p
 ¬ is_Fzero q
 IsExpansion b radix (p :: L1) →
 IsExpansion b radix (p :: L2) →
 In q (addExp L1 L2) → (MSB radix p < LSB radix q)%Z.
intros L1; elim L1; simpl in |- *; auto.
intros L2 p q H' H'0 H'1 H'2 H'3.
apply IsExpansionConsInv with (L := L2); auto.
intros a l H' L2 p q H'0 H'1 H'2 H'3; CaseEq (growExp a L2); simpl in |- ×.
intros H'4 H'5.
apply IsExpansionConsInv with (L := a :: l); auto with datatypes.
intros f l0 H'4 H'5; elim H'5; clear H'5; intros H'5;
 [ rewrite <- H'5 | idtac ]; auto.
generalize H'3 H'4; case L2; simpl in |- *; auto.
intros H'6 H'7; inversion H'7.
rewrite <- H0; auto.
apply IsExpansionConsInv with (L := a :: l); auto with datatypes.
rewrite H0; auto.
rewrite H'5; auto.
intros f0 l1 H'6; CaseEq (TwoSum a f0).
intros f1 f2 H'7 H'8; inversion H'8.
cut (¬ is_Fzero a); [ intros Za | idtac ].
cut (¬ is_Fzero f0); [ intros Zf0 | idtac ].
apply Zlt_le_trans with (Zmin (LSB radix a) (LSB radix f0)).
unfold Zmin in |- *; case (LSB radix a ?= LSB radix f0)%Z.
apply IsExpansionConsInv with (L := a :: l); auto with datatypes.
apply IsExpansionConsInv with (L := a :: l); auto with datatypes.
apply IsExpansionConsInv with (L := f0 :: l1); auto with datatypes.
replace f with (snd (TwoSum a f0)); [ idtac | rewrite H'7; auto ];
 apply TwoSumLt2; auto.
apply expBoundedInv with (radix := radix) (L := l); auto.
apply expInv with (a := p); auto.
apply expBoundedInv with (radix := radix) (L := l1); auto.
apply expInv with (a := p); auto.
rewrite H'7; simpl in |- ×.
rewrite H0.
rewrite H'5; auto.
Contradict H'1.
rewrite <- H'5.
rewrite <- H0.
replace f2 with (snd (TwoSum a f0)); [ idtac | rewrite H'7; auto ];
 apply (is_Fzero_rep2 radix); auto; apply TwoSumOl2;
 auto.
apply expBoundedInv with (radix := radix) (L := l); auto.
apply expInv with (a := p); auto.
apply expBoundedInv with (radix := radix) (L := l1); auto.
apply expInv with (a := p); auto.
Contradict H'1.
rewrite <- H'5.
rewrite <- H0.
replace f2 with (snd (TwoSum a f0)); [ idtac | rewrite H'7; auto ];
 apply (is_Fzero_rep2 radix); auto; apply TwoSumOr2;
 auto.
apply expBoundedInv with (radix := radix) (L := l); auto.
apply expInv with (a := p); auto.
apply expBoundedInv with (radix := radix) (L := l1); auto.
apply expInv with (a := p); auto.
apply (H' l0); auto.
apply IsExpansionSkip with (q := a); auto.
apply IsExpansionCons; auto.
apply expInv with (a := f); auto.
rewrite <- H'4.
apply growExpIsExp; auto.
apply expInv with (a := p); auto.
apply expBoundedInv with (radix := radix) (L := l); auto.
apply expInv with (a := p); auto.
apply expBoundedInv with (radix := radix) (L := L2); auto.
intros q0 H'6 H'7.
case (IsExpansionGrowConsInvAux (p :: L2) H'3 L2 p q0 a); auto.
apply expBoundedInv with (radix := radix) (L := l); auto.
apply expInv with (a := p); auto.
rewrite H'4; auto with datatypes.
intros H'8 H'9; case (is_FzeroP a); auto.
intros H'10; case H'9; auto.
intros H'11; apply Zlt_le_trans with (2 := H'11); auto.
apply IsExpansionConsInv with (L := a :: l); auto with datatypes.
Qed.

Theorem addExpIsExp :
  L1 L2 : list float,
 IsExpansion b radix L1
 IsExpansion b radix L2IsExpansion b radix (addExp L1 L2).
intros L1; elim L1; simpl in |- *; auto.
intros a l Rec L2 HL1 HL2.
cut (Fbounded b a);
 [ intros Fba | apply (expBoundedInv b radix) with (L := l) ];
 auto.
generalize (growExpIsVal L2 HL2 a Fba);
 generalize (growExpIsExp L2 HL2 a Fba); CaseEq (growExp a L2);
 simpl in |- *; auto.
intros H' H'0 H'1.
apply expInv with (a := a); auto.
intros f l0 H' H'0 H'1.
case (is_FzeroP f); intros Z1; auto.
apply IsExpansionTop1; auto.
apply expBoundedInv with (radix := radix) (L := l0); auto.
apply Rec; auto.
apply expInv with (a := a); auto.
apply expInv with (a := f); auto.
apply IsExpansionCons; auto.
apply Rec; auto.
apply expInv with (a := a); auto.
apply expInv with (a := f); auto.
apply expBoundedInv with (radix := radix) (L := l0); auto.
intros q H'2 H'3.
apply IsExpansionAddInv with (L1 := l) (L2 := l0); auto.
generalize H' HL2; case L2; simpl in |- *; auto.
intros H'4; inversion H'4; auto.
rewrite <- H0; auto.
intros f0 l1; CaseEq (TwoSum a f0).
intros f1 f2 H'4 H'5; inversion H'5.
intros H'6.
cut (¬ is_Fzero a); [ intros Z2 | idtac ].
apply IsExpansionCons; auto.
apply expInv with (a := a); auto.
apply expBoundedInv with (radix := radix) (L := l0); auto.
intros q0 H'7 H'8.
apply Zle_lt_trans with (MSB radix a).
apply MSB_monotone; auto.
rewrite <- H0; auto.
repeat rewrite (Fabs_correct radix); auto with arith.
replace (FtoR radix f2) with (FtoRradix (snd (TwoSum a f0)));
 [ idtac | rewrite H'4; auto ].
rewrite TwoSum2; auto.
replace (FtoR radix a) with (a + f0 - f0)%R;
 [ idtac | unfold FtoRradix in |- *; ring ].
cut ( x y z : R, Rabs (x + y - z) = Rabs (z - (x + y)));
 [ intros Ra1; repeat rewrite Ra1
 | intros; rewrite <- Ropp_minus_distr; rewrite Rabs_Ropp ];
 auto.
case (TwoSum1 a f0); auto.
apply expBoundedInv with (radix := radix) (L := l1); auto.
intros H'9 H'10; apply H'10; auto.
apply expBoundedInv with (radix := radix) (L := l1); auto.
apply expBoundedInv with (radix := radix) (L := l1); auto.
apply IsExpansionConsInv with (L := l); auto.
Contradict Z1.
rewrite <- H0.
replace f2 with (snd (TwoSum a f0)).
apply (is_Fzero_rep2 radix); auto.
apply TwoSumOr2; auto.
apply expBoundedInv with (radix := radix) (L := l1); auto.
rewrite H'4; auto.
Qed.
End mf.