Push to branch with affine arith changes

coq/Infra/MachineType.v

@@ -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) *)