Commit 60631b5d authored by Guillaume Melquiond's avatar Guillaume Melquiond

Make it compile with both Coq 8.4 and trunk.

parent 218bcb9b
......@@ -13,3 +13,7 @@ html
src/Flocq_version.v
*.vo
*.glob
.*.aux
N*.cm*
N*.native
N*.o
......@@ -46,6 +46,8 @@ End AnyRadix.
Section Binary.
Implicit Arguments exist [[A] [P]].
(** prec is the number of bits of the mantissa including the implicit one
emax is the exponent of the infinities
Typically p=24 and emax = 128 in single precision *)
......@@ -89,7 +91,7 @@ Definition FF2B x :=
| F754_finite s m e => B754_finite s m e
| F754_infinity s => fun _ => B754_infinity s
| F754_zero s => fun _ => B754_zero s
| F754_nan b pl => fun H => B754_nan b (exist _ pl H)
| F754_nan b pl => fun H => B754_nan b (exist pl H)
end.
Definition B2FF x :=
......@@ -601,7 +603,7 @@ induction (nat_of_P n).
simpl.
rewrite Zplus_0_r.
now destruct l as [|[| |]].
simpl iter_nat.
simpl nat_rect.
rewrite inj_S.
unfold Zsucc.
rewrite Zplus_assoc.
......
......@@ -25,6 +25,12 @@ Require Import Fappli_IEEE.
Section Binary_Bits.
Implicit Arguments exist [[A] [P]].
Implicit Arguments B754_zero [[prec] [emax]].
Implicit Arguments B754_infinity [[prec] [emax]].
Implicit Arguments B754_nan [[prec] [emax]].
Implicit Arguments B754_finite [[prec] [emax]].
(** Number of bits for the fraction and exponent *)
Variable mw ew : Z.
Hypothesis Hmw : (0 < mw)%Z.
......@@ -516,6 +522,8 @@ End Binary_Bits.
(** Specialization for IEEE single precision operations *)
Section B32_Bits.
Implicit Arguments B754_nan [[prec] [emax]].
Definition binary32 := binary_float 24 128.
Let Hprec : (0 < 24)%Z.
......@@ -527,7 +535,7 @@ apply refl_equal.
Qed.
Definition default_nan_pl32 : bool * nan_pl 24 :=
(false, exist _ (nat_iter 22 xO xH) (refl_equal true)).
(false, exist _ (iter_nat 22 _ xO xH) (refl_equal true)).
Definition unop_nan_pl32 (f : binary32) : bool * nan_pl 24 :=
match f with
......@@ -557,6 +565,8 @@ End B32_Bits.
(** Specialization for IEEE double precision operations *)
Section B64_Bits.
Implicit Arguments B754_nan [[prec] [emax]].
Definition binary64 := binary_float 53 1024.
Let Hprec : (0 < 53)%Z.
......@@ -568,7 +578,7 @@ apply refl_equal.
Qed.
Definition default_nan_pl64 : bool * nan_pl 53 :=
(false, exist _ (nat_iter 51 xO xH) (refl_equal true)).
(false, exist _ (iter_nat 51 _ xO xH) (refl_equal true)).
Definition unop_nan_pl64 (f : binary64) : bool * nan_pl 53 :=
match f with
......
......@@ -168,7 +168,7 @@ apply Rplus_lt_reg_r with (d * (v - 1))%R.
ring_simplify.
rewrite Rmult_comm.
now apply Rmult_lt_compat_l.
apply Rplus_lt_reg_r with (-u * v)%R.
apply Rplus_lt_reg_l with (-u * v)%R.
replace (- u * v + (d + v * (u - d)))%R with (d * (1 - v))%R by ring.
replace (- u * v + u)%R with (u * (1 - v))%R by ring.
apply Rmult_lt_compat_r.
......
......@@ -28,6 +28,8 @@ Variable beta : radix.
Notation bpow e := (bpow beta e).
Implicit Arguments Float [[beta]].
Definition Falign (f1 f2 : float beta) :=
let '(Float m1 e1) := f1 in
let '(Float m2 e2) := f2 in
......@@ -38,7 +40,7 @@ Definition Falign (f1 f2 : float beta) :=
Theorem Falign_spec :
forall f1 f2 : float beta,
let '(m1, m2, e) := Falign f1 f2 in
F2R f1 = F2R (Float beta m1 e) /\ F2R f2 = F2R (Float beta m2 e).
F2R f1 = @F2R beta (Float m1 e) /\ F2R f2 = @F2R beta (Float m2 e).
Proof.
unfold Falign.
intros (m1, e1) (m2, e2).
......@@ -61,9 +63,9 @@ case (Zmin_spec e1 e2); intros (H1,H2); easy.
case (Zmin_spec e1 e2); intros (H1,H2); easy.
Qed.
Definition Fopp (f1: float beta) :=
Definition Fopp (f1 : float beta) : float beta :=
let '(Float m1 e1) := f1 in
Float beta (-m1)%Z e1.
Float (-m1)%Z e1.
Theorem F2R_opp :
forall f1 : float beta,
......@@ -72,9 +74,9 @@ intros (m1,e1).
apply F2R_Zopp.
Qed.
Definition Fabs (f1: float beta) :=
Definition Fabs (f1 : float beta) : float beta :=
let '(Float m1 e1) := f1 in
Float beta (Zabs m1)%Z e1.
Float (Zabs m1)%Z e1.
Theorem F2R_abs :
forall f1 : float beta,
......@@ -83,9 +85,9 @@ intros (m1,e1).
apply F2R_Zabs.
Qed.
Definition Fplus (f1 f2 : float beta) :=
Definition Fplus (f1 f2 : float beta) : float beta :=
let '(m1, m2 ,e) := Falign f1 f2 in
Float beta (m1 + m2) e.
Float (m1 + m2) e.
Theorem F2R_plus :
forall f1 f2 : float beta,
......@@ -104,7 +106,7 @@ Qed.
Theorem Fplus_same_exp :
forall m1 m2 e,
Fplus (Float beta m1 e) (Float beta m2 e) = Float beta (m1 + m2) e.
Fplus (Float m1 e) (Float m2 e) = Float (m1 + m2) e.
Proof.
intros m1 m2 e.
unfold Fplus.
......@@ -136,17 +138,17 @@ Qed.
Theorem Fminus_same_exp :
forall m1 m2 e,
Fminus (Float beta m1 e) (Float beta m2 e) = Float beta (m1 - m2) e.
Fminus (Float m1 e) (Float m2 e) = Float (m1 - m2) e.
Proof.
intros m1 m2 e.
unfold Fminus.
apply Fplus_same_exp.
Qed.
Definition Fmult (f1 f2 : float beta) :=
Definition Fmult (f1 f2 : float beta) : float beta :=
let '(Float m1 e1) := f1 in
let '(Float m2 e2) := f2 in
Float beta (m1 * m2) (e1 + e2).
Float (m1 * m2) (e1 + e2).
Theorem F2R_mult :
forall f1 f2 : float beta,
......
......@@ -73,6 +73,24 @@ apply Rplus_eq_reg_l with r.
now rewrite 2!(Rplus_comm r).
Qed.
Theorem Rplus_lt_reg_l :
forall r r1 r2 : R,
(r + r1 < r + r2)%R -> (r1 < r2)%R.
Proof.
intros.
solve [ apply Rplus_lt_reg_l with (1 := H) |
apply Rplus_lt_reg_r with (1 := H) ].
Qed.
Theorem Rplus_lt_reg_r :
forall r r1 r2 : R,
(r1 + r < r2 + r)%R -> (r1 < r2)%R.
Proof.
intros.
apply Rplus_lt_reg_l with r.
now rewrite 2!(Rplus_comm r).
Qed.
Theorem Rplus_le_reg_r :
forall r r1 r2 : R,
(r1 + r <= r2 + r)%R -> (r1 <= r2)%R.
......
......@@ -18,7 +18,7 @@ COPYING file for more details.
*)
Require Import ZArith.
Require Import ZOdiv.
Require Import Zquot.
Section Zmissing.
......@@ -385,26 +385,26 @@ Qed.
Theorem ZOmod_eq :
forall a b,
ZOmod a b = (a - ZOdiv a b * b)%Z.
Z.rem a b = (a - Z.quot a b * b)%Z.
Proof.
intros a b.
rewrite (ZO_div_mod_eq a b) at 2.
rewrite (Z.quot_rem' a b) at 2.
ring.
Qed.
Theorem ZOmod_mod_mult :
forall n a b,
ZOmod (ZOmod n (a * b)) b = ZOmod n b.
Z.rem (Z.rem n (a * b)) b = Z.rem n b.
Proof.
intros n a b.
assert (ZOmod n (a * b) = n + - (ZOdiv n (a * b) * a) * b)%Z.
assert (Z.rem n (a * b) = n + - (Z.quot n (a * b) * a) * b)%Z.
rewrite <- Zopp_mult_distr_l.
rewrite <- Zmult_assoc.
apply ZOmod_eq.
rewrite H.
apply ZO_mod_plus.
apply Z_rem_plus.
rewrite <- H.
apply ZOmod_sgn2.
apply Zrem_sgn2.
Qed.
Theorem Zdiv_mod_mult :
......@@ -434,73 +434,73 @@ Qed.
Theorem ZOdiv_mod_mult :
forall n a b,
(ZOdiv (ZOmod n (a * b)) a) = ZOmod (ZOdiv n a) b.
(Z.quot (Z.rem n (a * b)) a) = Z.rem (Z.quot n a) b.
Proof.
intros n a b.
destruct (Z_eq_dec a 0) as [Za|Za].
rewrite Za.
now rewrite 2!ZOdiv_0_r, ZOmod_0_l.
assert (ZOmod n (a * b) = n + - (ZOdiv (ZOdiv n a) b * b) * a)%Z.
now rewrite 2!Zquot_0_r, Zrem_0_l.
assert (Z.rem n (a * b) = n + - (Z.quot (Z.quot n a) b * b) * a)%Z.
rewrite (ZOmod_eq n (a * b)) at 1.
rewrite ZOdiv_ZOdiv.
rewrite Zquot_Zquot.
ring.
rewrite H.
rewrite ZO_div_plus with (2 := Za).
rewrite Z_quot_plus with (2 := Za).
apply sym_eq.
apply ZOmod_eq.
rewrite <- H.
apply ZOmod_sgn2.
apply Zrem_sgn2.
Qed.
Theorem ZOdiv_small_abs :
forall a b,
(Zabs a < b)%Z -> ZOdiv a b = Z0.
(Zabs a < b)%Z -> Z.quot a b = Z0.
Proof.
intros a b Ha.
destruct (Zle_or_lt 0 a) as [H|H].
apply ZOdiv_small.
apply Zquot_small.
split.
exact H.
now rewrite Zabs_eq in Ha.
apply Zopp_inj.
rewrite <- ZOdiv_opp_l, Zopp_0.
apply ZOdiv_small.
rewrite <- Zquot_opp_l, Zopp_0.
apply Zquot_small.
generalize (Zabs_non_eq a).
omega.
Qed.
Theorem ZOmod_small_abs :
forall a b,
(Zabs a < b)%Z -> ZOmod a b = a.
(Zabs a < b)%Z -> Z.rem a b = a.
Proof.
intros a b Ha.
destruct (Zle_or_lt 0 a) as [H|H].
apply ZOmod_small.
apply Zrem_small.
split.
exact H.
now rewrite Zabs_eq in Ha.
apply Zopp_inj.
rewrite <- ZOmod_opp_l.
apply ZOmod_small.
rewrite <- Zrem_opp_l.
apply Zrem_small.
generalize (Zabs_non_eq a).
omega.
Qed.
Theorem ZOdiv_plus :
forall a b c, (0 <= a * b)%Z ->
(ZOdiv (a + b) c = ZOdiv a c + ZOdiv b c + ZOdiv (ZOmod a c + ZOmod b c) c)%Z.
(Z.quot (a + b) c = Z.quot a c + Z.quot b c + Z.quot (Z.rem a c + Z.rem b c) c)%Z.
Proof.
intros a b c Hab.
destruct (Z_eq_dec c 0) as [Zc|Zc].
now rewrite Zc, 4!ZOdiv_0_r.
now rewrite Zc, 4!Zquot_0_r.
apply Zmult_reg_r with (1 := Zc).
rewrite 2!Zmult_plus_distr_l.
assert (forall d, ZOdiv d c * c = d - ZOmod d c)%Z.
assert (forall d, Z.quot d c * c = d - Z.rem d c)%Z.
intros d.
rewrite ZOmod_eq.
ring.
rewrite 4!H.
rewrite <- ZOplus_mod with (1 := Hab).
rewrite <- Zplus_rem with (1 := Hab).
ring.
Qed.
......@@ -543,14 +543,14 @@ Qed.
Theorem Zsame_sign_odiv :
forall u v, (0 <= v)%Z ->
(0 <= u * ZOdiv u v)%Z.
(0 <= u * Z.quot u v)%Z.
Proof.
intros u v Hv.
apply Zsame_sign_imp ; intros Hu.
apply ZO_div_pos with (2 := Hv).
apply Z_quot_pos with (2 := Hv).
now apply Zlt_le_weak.
rewrite <- ZOdiv_opp_l.
apply ZO_div_pos with (2 := Hv).
rewrite <- Zquot_opp_l.
apply Z_quot_pos with (2 := Hv).
now apply Zlt_le_weak.
Qed.
......
This diff is collapsed.
......@@ -1793,7 +1793,7 @@ rewrite Z2R_plus. simpl.
destruct (Rcompare_spec (x - Z2R (Zfloor x)) (/ 2)) as [H1|H1|H1] ; apply sym_eq.
(* . *)
apply Rcompare_Lt.
apply Rplus_lt_reg_r with (x - Z2R (Zfloor x))%R.
apply Rplus_lt_reg_l with (x - Z2R (Zfloor x))%R.
replace (x - Z2R (Zfloor x) + (x - Z2R (Zfloor x)))%R with ((x - Z2R (Zfloor x)) * 2)%R by ring.
replace (x - Z2R (Zfloor x) + (Z2R (Zfloor x) + 1 - x))%R with (/2 * 2)%R by field.
apply Rmult_lt_compat_r with (2 := H1).
......@@ -1805,7 +1805,7 @@ rewrite H1.
field.
(* . *)
apply Rcompare_Gt.
apply Rplus_lt_reg_r with (x - Z2R (Zfloor x))%R.
apply Rplus_lt_reg_l with (x - Z2R (Zfloor x))%R.
replace (x - Z2R (Zfloor x) + (x - Z2R (Zfloor x)))%R with ((x - Z2R (Zfloor x)) * 2)%R by ring.
replace (x - Z2R (Zfloor x) + (Z2R (Zfloor x) + 1 - x))%R with (/2 * 2)%R by field.
apply Rmult_lt_compat_r with (2 := H1).
......@@ -1823,7 +1823,7 @@ rewrite Z2R_plus. simpl.
destruct (Rcompare_spec (Z2R (Zfloor x) + 1 - x) (/ 2)) as [H1|H1|H1] ; apply sym_eq.
(* . *)
apply Rcompare_Lt.
apply Rplus_lt_reg_r with (Z2R (Zfloor x) + 1 - x)%R.
apply Rplus_lt_reg_l with (Z2R (Zfloor x) + 1 - x)%R.
replace (Z2R (Zfloor x) + 1 - x + (Z2R (Zfloor x) + 1 - x))%R with ((Z2R (Zfloor x) + 1 - x) * 2)%R by ring.
replace (Z2R (Zfloor x) + 1 - x + (x - Z2R (Zfloor x)))%R with (/2 * 2)%R by field.
apply Rmult_lt_compat_r with (2 := H1).
......@@ -1835,7 +1835,7 @@ rewrite H1.
field.
(* . *)
apply Rcompare_Gt.
apply Rplus_lt_reg_r with (Z2R (Zfloor x) + 1 - x)%R.
apply Rplus_lt_reg_l with (Z2R (Zfloor x) + 1 - x)%R.
replace (Z2R (Zfloor x) + 1 - x + (Z2R (Zfloor x) + 1 - x))%R with ((Z2R (Zfloor x) + 1 - x) * 2)%R by ring.
replace (Z2R (Zfloor x) + 1 - x + (x - Z2R (Zfloor x)))%R with (/2 * 2)%R by field.
apply Rmult_lt_compat_r with (2 := H1).
......@@ -1861,11 +1861,11 @@ rewrite Zceil_floor_neq.
rewrite Z2R_plus.
simpl.
apply Ropp_lt_cancel.
apply Rplus_lt_reg_r with R1.
apply Rplus_lt_reg_l with R1.
replace (1 + -/2)%R with (/2)%R by field.
now replace (1 + - (Z2R (Zfloor x) + 1 - x))%R with (x - Z2R (Zfloor x))%R by ring.
apply Rlt_not_eq.
apply Rplus_lt_reg_r with (- Z2R (Zfloor x))%R.
apply Rplus_lt_reg_l with (- Z2R (Zfloor x))%R.
apply Rlt_trans with (/2)%R.
rewrite Rplus_opp_l.
apply Rinv_0_lt_compat.
......@@ -1897,7 +1897,7 @@ rewrite Hx.
rewrite Rabs_minus_sym.
now replace (1 - /2)%R with (/2)%R by field.
apply Rlt_not_eq.
apply Rplus_lt_reg_r with (- Z2R (Zfloor x))%R.
apply Rplus_lt_reg_l with (- Z2R (Zfloor x))%R.
rewrite Rplus_opp_l, Rplus_comm.
fold (x - Z2R (Zfloor x))%R.
rewrite Hx.
......
......@@ -325,7 +325,7 @@ destruct (round_DN_or_UP beta fexp rnd x) as [H|H] ; rewrite H ; clear H.
(* . *)
rewrite Rabs_left1.
rewrite Ropp_minus_distr.
apply Rplus_lt_reg_r with (round beta fexp Zfloor x).
apply Rplus_lt_reg_l with (round beta fexp Zfloor x).
rewrite <- ulp_DN_UP with (1 := Hx).
ring_simplify.
assert (Hu: (x <= round beta fexp Zceil x)%R).
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment