Commit c6efd235 authored by Heiko Becker's avatar Heiko Becker

Push to branch with affine arith changes

parent 34203766
This diff is collapsed.
......@@ -19,7 +19,33 @@ From Flover
the base field.
**)
Inductive mType: Type := REAL | M16 | M32 | M64
| F (w:positive) (f:positive). (*| M128 | M256*)
| F (w:positive) (f:nat). (*| M128 | M256*)
Definition isFixedPoint m :Prop :=
match m with
|F _ _ => True
| _ => False
end.
Definition isFixedPointB m :bool :=
match m with
|F _ _ => true
| _ => false
end.
Lemma isFixedPoint_isFixedPointB m :
isFixedPoint m <-> isFixedPointB m = true.
Proof.
destruct m; unfold isFixedPoint; simpl; split; try congruence; try auto.
Qed.
Lemma isFixedPoint_isFixedPointB_false m:
(~ isFixedPoint m) <-> isFixedPointB m = false.
Proof.
destruct m; unfold isFixedPoint; simpl; split; try congruence; try auto.
intros.
exfalso; auto.
Qed.
(**
Compute a machine epsilon from a machine types in Q
......@@ -30,7 +56,7 @@ Definition mTypeToR (m:mType) :R :=
| M16 => 1 / 2^11
| M32 => 1/ 2^24
| M64 => 1/ 2^53
| F w f => 1/ 2^(Pos.to_nat f)
| F w f => 1/ 2^f
(*
(* the epsilons below match what is used internally in Daisy,
although these value do not match the IEEE standard *)
......@@ -44,7 +70,7 @@ Definition mTypeToQ (m:mType) :Q :=
| M16 => (Qpower (2#1) (Zneg 11))
| M32 => (Qpower (2#1) (Zneg 24))
| M64 => (Qpower (2#1) (Zneg 53))
| F w f => Qpower (2#1) (Zneg f)
| F w f => Qpower (2#1) (- Z.of_nat f)
(*
(* the epsilons below match what is used internally in Daisy,
although these value do not match the IEEE standard *)
......@@ -77,24 +103,32 @@ Lemma mTypeToQ_mTypeToR m :
Q2R (mTypeToQ m) = mTypeToR m.
Proof.
destruct m; cbn; try auto using Q2R0_is_0; try (unfold Q2R; simpl; lra).
pose proof (Qpower_opp (2#1) (Z.of_nat f)) as Qpower_eq.
apply Qeq_eqR in Qpower_eq.
rewrite Qpower_eq.
rewrite Q2R_inv.
- unfold Rdiv. rewrite Rmult_1_l.
f_equal.
rewrite Qpower_decomp.
unfold Q2R; simpl.
rewrite Zpower_pos_powerRZ.
rewrite pow_powerRZ.
rewrite positive_nat_Z.
assert (IZR (Z.pos (1 ^ f)) = 1%R) as pow_1.
{ unfold IZR.
f_equal.
rewrite Pos_pow_1_l; auto. }
rewrite pow_1.
rewrite Rinv_1, Rmult_1_r; auto.
destruct (Z.of_nat f) eqn:z_nat; try (destruct f; cbn in z_nat; congruence).
+ cbn. destruct f; simpl in *; try congruence.
lra.
+ unfold Qpower.
rewrite Qpower_decomp.
unfold Q2R; simpl.
rewrite Zpower_pos_powerRZ.
rewrite pow_powerRZ.
rewrite <- z_nat.
assert (IZR (Z.pos (1 ^ p)) = 1%R) as pow_1.
{ unfold IZR.
f_equal.
rewrite Pos_pow_1_l; auto. }
rewrite pow_1.
rewrite Rinv_1, Rmult_1_r; auto.
- hnf; intros power_0.
destruct f; simpl in *; try lra.
rewrite Qpower_decomp in *.
unfold Qeq in *; simpl in *.
pose proof (Zpow_facts.Zpower_pos_pos 2 f) as Zpower_pos.
pose proof (Zpow_facts.Zpower_pos_pos 2 (Pos.of_succ_nat f)) as Zpower_pos.
assert (0 <2)%Z as pos2 by (omega).
specialize (Zpower_pos pos2).
rewrite Z.mul_1_r in *.
......@@ -143,6 +177,8 @@ Lemma mTypeToQ_pos_Q m:
0 <= mTypeToQ m.
Proof.
destruct m; simpl; cbn; try lra.
unfold Qpower.
destruct f; simpl in *; try lra.
apply Qinv_le_0_compat.
apply Qpower_pos_positive.
lra.
......@@ -163,7 +199,7 @@ Definition mTypeEq (m1:mType) (m2:mType) :=
| M16, M16 => true
| M32, M32 => true
| M64, M64 => true
| F w1 f1, F w2 f2 => (w1 =? w2)%positive && (f1 =? f2)%positive
| F w1 f1, F w2 f2 => (w1 =? w2)%positive && (f1 =? f2)%nat
(* | M128, M128 => true *)
(* | M256, M256 => true *)
| _, _ => false
......@@ -173,7 +209,7 @@ Lemma mTypeEq_refl (m:mType):
mTypeEq m m = true.
Proof.
intros. destruct m; try auto; simpl.
repeat rewrite Pos.eqb_refl; auto.
rewrite Pos.eqb_refl, Nat.eqb_refl; auto.
Qed.
Lemma mTypeEq_compat_eq(m1:mType) (m2:mType):
......@@ -185,6 +221,7 @@ Proof.
try congruence; try auto;
try simpl in eq_case; try inversion eq_case.
- andb_to_prop eq_case. f_equal; auto using Peqb_true_eq.
rewrite <- Nat.eqb_eq; auto.
- inversion m2_case. apply mTypeEq_refl.
Qed.
......@@ -196,8 +233,8 @@ Proof.
congruence.
- case_eq m1; intros; case_eq m2; intros; subst; simpl; try congruence.
destruct (w =? w0)%positive eqn:?; try auto.
destruct (f =? f0)%positive eqn:?; try auto.
rewrite Pos.eqb_eq in *; subst. congruence.
destruct (f =? f0)%nat eqn:?; try auto.
rewrite Pos.eqb_eq, Nat.eqb_eq in *; subst. congruence.
Qed.
Ltac type_conv :=
......@@ -213,7 +250,7 @@ Proof.
intros.
destruct m1, m2; simpl; auto.
rewrite Pos.eqb_sym; f_equal.
apply Pos.eqb_sym.
apply Nat.eqb_sym.
Qed.
(**
......@@ -229,7 +266,7 @@ Qed.
Definition isMorePrecise (m1:mType) (m2:mType) :=
match m1, m2 with
|REAL, _ => true
| F w1 f1, F w2 f2 => (w1 <=? w2)%positive (*&& (f1 <=? f2)%positive *)
| F w1 f1, F w2 f2 => (w2 <=? w1)%positive (*&& (f1 <=? f2)%positive *)
| F w f, _ => false
| _ , F w f => false
| _, _ => Qle_bool (mTypeToQ m1) (mTypeToQ m2)
......@@ -240,7 +277,7 @@ Definition isMorePrecise (m1:mType) (m2:mType) :=
Definition morePrecise (m1:mType) (m2:mType) :=
match m1, m2 with
| REAL, _ => true
| F w1 f1, F w2 f2 => (w1 <=? w2)%positive (*&& (f1 <=? f2)%positive*)
| F w1 f1, F w2 f2 => (w2 <=? w1)%positive (*&& (f1 <=? f2)%positive*)
| _ , F w f => false
| F w f, _ => false
| M16, M16 => true
......@@ -251,20 +288,6 @@ Definition morePrecise (m1:mType) (m2:mType) :=
| _, _ => false
end.
(* Lemma morePrecise_antisym m1 m2: *)
(* morePrecise m1 m2 = true -> *)
(* morePrecise m2 m1 = true -> *)
(* mTypeEq m1 m2 = true. *)
(* Proof. *)
(* destruct m1; destruct m2; simpl; auto. *)
(* intros le_m1m2 le_m2m1. andb_to_prop le_m1m2. andb_to_prop le_m2m1. *)
(* apply Pos.leb_le in L; apply Pos.leb_le in R. *)
(* apply Pos.leb_le in L0; apply Pos.leb_le in R0. *)
(* split_bool; *)
(* apply Pos.eqb_eq; *)
(* apply Pos.le_antisym; auto. *)
(* Qed. *)
Lemma morePrecise_trans m1 m2 m3:
morePrecise m1 m2 = true ->
morePrecise m2 m3 = true ->
......@@ -313,11 +336,20 @@ Qed.
in which evaluation has to be performed, e.g. addition of 32 and 64 bit floats
has to happen in 64 bits
**)
Definition join (m1:mType) (m2:mType) :=
if (morePrecise m1 m2) then m1 else m2.
Definition join (m1:mType) (m2:mType) (fracBits:nat) :option mType:=
match m1, m2 with
| F w1 f1, F w2 f2 =>
if (w2 <=? w1)%positive
then Some (F w1 fracBits)
else Some (F w2 fracBits)
| F _ _, _ => None
| _ , F _ _ => None
| _ , _ => if (morePrecise m1 m2) then Some m1 else Some m2
end.
Definition join3 (m1:mType) (m2:mType) (m3:mType) :=
join m1 (join m2 m3).
Definition join3 (m1:mType) (m2:mType) (m3:mType) (fBits:nat):=
olet msub := (join m2 m3 fBits) in
join m1 msub fBits.
(* Lemma REAL_join_is_REAL m1 m2: *)
(* join m1 m2 = REAL -> m1 = REAL /\ m2 = REAL. *)
......@@ -327,7 +359,7 @@ Definition join3 (m1:mType) (m2:mType) (m3:mType) :=
(* destruct m1, m2; simpl in *; cbv in *; try congruence; try auto. *)
(* Qed. *)
Definition maxExponent (m:mType) :positive :=
Definition maxExponent (m:mType) :nat :=
match m with
| REAL => 1
| M16 => 15
......@@ -336,7 +368,7 @@ Definition maxExponent (m:mType) :positive :=
| F w f => f
end.
Definition minExponentPos (m:mType) :positive :=
Definition minExponentPos (m:mType) :nat :=
match m with
| REAL => 1
| M16 => 14
......@@ -357,15 +389,15 @@ Fixed-Points:
**)
Definition maxValue (m:mType) :=
match m with
|F w f => (((Z.pow_pos 2 (w -1))-1)#1) * Qinv ((Z.pow_pos 2 (maxExponent m))#1)
|_ => (Z.pow_pos 2 (maxExponent m)) # 1
|F w f => (((Z.pow_pos 2 (w -1))-1)#1) * Qinv ((Z.pow 2 (Z.of_nat (maxExponent m)))#1)
|_ => (Z.pow 2 (Z.of_nat (maxExponent m))) # 1
end.
(* Similarly: minimum values: we return 0 for fixed-point numbers here to make no fixed-point number be a denormal number ever*)
Definition minValue_pos (m:mType) :=
match m with
|F w f => 0
| _ => Qinv ((Z.pow_pos 2 (minExponentPos m)) # 1)
| _ => Qinv ((Z.pow 2 (Z.of_nat (minExponentPos m))) # 1)
end.
(* (** Goldberg - Handbook of Floating-Point Arithmetic: (p.183) *)
......
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