Add Fixed-Point checking to FloVer in Coq.

Refactor error computation in semantics into separate function/Proposition
to be able to differentiate between truncation and rounding-to-nearest error.

coq/Environments.v

 (**
 Environment library.
-Defines the environment type for the Flover framework and a simulation relation between environments.
+Defines the environment type for the Flover framework and a simulation relation
+between environments.
  **)
-Require Import Coq.Reals.Reals Coq.micromega.Psatz Coq.QArith.Qreals.
-Require Import Flover.Infra.ExpressionAbbrevs Flover.Infra.RationalSimps Flover.Commands.
+From Coq
+     Require Import Reals.Reals micromega.Psatz QArith.Qreals.
+
+From Flover
+     Require Import Infra.ExpressionAbbrevs Infra.RationalSimps Commands.
 
 (**
 Define an approximation relation between two environments.
@@ -12,20 +16,25 @@ It is necessary to have this relation, since two evaluations of the very same
 exprression may yield different values for different machine epsilons
 (or environments that already only approximate each other)
  **)
-Inductive approxEnv : env -> (nat -> option mType) -> analysisResult -> NatSet.t -> NatSet.t -> env -> Prop :=
+Inductive approxEnv : env -> (nat -> option mType) -> analysisResult -> NatSet.t
+                      -> NatSet.t -> env -> Prop :=
 |approxRefl defVars A:
    approxEnv emptyEnv defVars A NatSet.empty NatSet.empty emptyEnv
 |approxUpdFree E1 E2 defVars A v1 v2 x fVars dVars m:
    approxEnv E1 defVars A fVars dVars E2 ->
-   (Rabs (v1 - v2) <= (Rabs v1) * Q2R (mTypeToQ m))%R ->
+   (Rabs (v1 - v2) <= computeErrorR v1 m)%R ->
    NatSet.mem x (NatSet.union fVars dVars) = false ->
-   approxEnv (updEnv x v1 E1) (updDefVars x m defVars) A (NatSet.add x fVars) dVars (updEnv x v2 E2)
+   approxEnv (updEnv x v1 E1)
+             (updDefVars x m defVars) A (NatSet.add x fVars) dVars
+             (updEnv x v2 E2)
 |approxUpdBound E1 E2 defVars A v1 v2 x fVars dVars m iv err:
    approxEnv E1 defVars A fVars dVars E2 ->
    FloverMap.find (Var Q x) A = Some (iv, err) ->
    (Rabs (v1 - v2) <= Q2R err)%R ->
    NatSet.mem x (NatSet.union fVars dVars) = false ->
-   approxEnv (updEnv x v1 E1) (updDefVars x m defVars) A fVars (NatSet.add x dVars) (updEnv x v2 E2).
+   approxEnv (updEnv x v1 E1)
+             (updDefVars x m defVars) A fVars (NatSet.add x dVars)
+             (updEnv x v2 E2).
 
 Section RelationProperties.
 
@@ -68,7 +77,7 @@ Section RelationProperties.
     E2 x = Some v2 ->
     NatSet.In x fVars ->
     Gamma x = Some m ->
-    (Rabs (v - v2) <= (Rabs v) * Q2R (mTypeToQ m))%R.
+    (Rabs (v - v2) <= computeErrorR v m)%R.
   Proof.
     induction approxEnvs;
       intros E1_def E2_def x_free x_typed.

coq/FPRangeValidator.v

-
-(* TODO: Flocq ops open machine_ieeeTheory binary_ieeeTheory lift_ieeeTheory realTheory *)
 From Flover
      Require Import Expressions Commands Environments ssaPrgs Typing
      IntervalValidation ErrorValidation Infra.Ltacs Infra.RealRationalProps.

coq/IEEE_connection.v

@@ -519,8 +519,8 @@ Proof.
     exists f; split; try eauto.
     eapply Var_load; try auto. rewrite HE2; auto.
   - eexists; split; try eauto.
-    eapply (Const_dist' (delta:=0%R)); eauto.
-    + rewrite Rabs_R0; apply mTypeToQ_pos_R.
+    eapply (Const_dist') with (delta:=0%R); eauto.
+    + rewrite Rabs_R0; apply mTypeToR_pos_R.
     + unfold perturb. lra.
   - edestruct IHe as [v_e [eval_float_e eval_rel_e]]; eauto.
     assert (is_finite 53 1024 v_e = true).
@@ -595,8 +595,8 @@ Proof.
     { eapply (FPRangeValidator_sound (Binop b (B2Qexpr e1) (B2Qexpr e2)));
         try eauto; set_tac.
       - eapply eval_eq_env; eauto.
-        eapply (Binop_dist' (delta:=0)); eauto.
-        + rewrite Rabs_R0. apply mTypeToQ_pos_R.
+        eapply Binop_dist' with (delta:=0%R); eauto.
+        + rewrite Rabs_R0. apply mTypeToR_pos_R.
         + unfold perturb; lra.
       - Flover_compute.
         apply Is_true_eq_true.
@@ -632,18 +632,10 @@ Proof.
       eapply FPRangeValidator_sound with (e:=Binop b (B2Qexpr e1) (B2Qexpr e2)); eauto.
       - eapply eval_eq_env; eauto.
         eapply Binop_dist' with (delta:=eps); eauto.
-        simpl in H2. Transparent mTypeToQ. unfold mTypeToQ.
-        eapply Rle_trans; eauto.  unfold Qpower. unfold Qpower_positive.
-        assert (pow_pos Qmult (2#1) 53 = 9007199254740992 # 1 )
-          by (vm_compute; auto).
-        rewrite H19. rewrite Q2R_inv; try lra.
-        unfold Q2R, Qnum, Qden. unfold bpow.
-        assert (-53 + 1 = -52)%Z by auto.
-        rewrite H20.
-        assert (Z.pow_pos radix2 52 = 4503599627370496%Z) by (vm_compute; auto).
-        rewrite H21. unfold Z2R, P2R. lra.
-        unfold perturb.
-        repeat rewrite B2Q_B2R_eq; auto.
+        + simpl in H2. Transparent mTypeToQ. unfold mTypeToQ.
+          eapply Rle_trans; eauto.
+          simpl. lra.
+        + unfold perturb. repeat rewrite B2Q_B2R_eq; try auto.
       - cbn. Flover_compute.
         apply Is_true_eq_true.
         repeat (apply andb_prop_intro; split; try auto using Is_true_eq_left).
@@ -724,9 +716,9 @@ Proof.
         rewrite B2Q_B2R_eq; try auto.
         unfold dmode; rewrite add_round.
         eapply Binop_dist' with (delta:=0%R); eauto.
-        rewrite Rabs_R0; apply mTypeToQ_pos_R.
-        unfold perturb, evalBinop.
-        repeat rewrite B2Q_B2R_eq; try auto; lra.
+        { rewrite Rabs_R0; apply mTypeToR_pos_R. }
+        { unfold perturb, evalBinop. cbn.
+        repeat rewrite B2Q_B2R_eq; try auto; lra. }
       * simpl in *.
         destruct (rel_error_exists
                     (fun x => negb (Zeven x))
@@ -741,14 +733,7 @@ Proof.
           rewrite B2Q_B2R_eq; try auto.
           unfold dmode.
           eapply Binop_dist' with (delta:=eps); eauto.
-          - unfold mTypeToQ.
-            assert (join M64 M64 = M64) by (vm_compute; auto).
-            rewrite H1.
-            eapply Rle_trans; eauto.
-            unfold Qpower. unfold Qpower_positive.
-            assert (pow_pos Qmult (2#1) 53 = 9007199254740992 # 1 )
-              by (vm_compute; auto).
-            rewrite H12. rewrite Q2R_inv; try lra.
+          - cbn; lra.
           - unfold perturb, evalBinop.
             repeat rewrite B2Q_B2R_eq; try auto.
             rewrite <- round_eq. rewrite <- add_round; auto. }
@@ -768,8 +753,8 @@ Proof.
         rewrite B2Q_B2R_eq; try auto.
         unfold dmode; rewrite add_round.
         eapply Binop_dist' with (delta:=0%R); eauto.
-        rewrite Rabs_R0; apply mTypeToQ_pos_R.
-        unfold perturb, evalBinop.
+        rewrite Rabs_R0; apply mTypeToR_pos_R.
+        unfold perturb, evalBinop; cbn.
         repeat rewrite B2Q_B2R_eq; try auto; lra.
       * simpl in *.
         destruct (rel_error_exists
@@ -785,15 +770,8 @@ Proof.
           rewrite B2Q_B2R_eq; try auto.
           unfold dmode.
           eapply Binop_dist' with (delta:=eps); eauto.
-          - unfold mTypeToQ.
-            assert (join M64 M64 = M64) by (vm_compute; auto).
-            rewrite H1.
-            eapply Rle_trans; eauto.
-            unfold Qpower. unfold Qpower_positive.
-            assert (pow_pos Qmult (2#1) 53 = 9007199254740992 # 1 )
-              by (vm_compute; auto).
-            rewrite H12. rewrite Q2R_inv; try lra.
-          - unfold perturb, evalBinop.
+          - cbn; lra.
+          - unfold perturb, evalBinop; cbn.
             repeat rewrite B2Q_B2R_eq; try auto.
             rewrite <- round_eq. rewrite <- add_round; auto. }
     (* Multiplication *)
@@ -812,8 +790,8 @@ Proof.
         rewrite B2Q_B2R_eq; try auto.
         unfold dmode; rewrite mult_round.
         eapply Binop_dist' with (delta:=0%R); eauto.
-        rewrite Rabs_R0; apply mTypeToQ_pos_R.
-        unfold perturb, evalBinop.
+        rewrite Rabs_R0; apply mTypeToR_pos_R.
+        unfold perturb, evalBinop; cbn.
         repeat rewrite B2Q_B2R_eq; try auto; lra.
         rewrite finite_e1, finite_e2 in finite_res.
         auto.
@@ -831,14 +809,7 @@ Proof.
           rewrite B2Q_B2R_eq; try auto.
           unfold dmode.
           eapply Binop_dist' with (delta:=eps); eauto.
-          - unfold mTypeToQ.
-            assert (join M64 M64 = M64) by (vm_compute; auto).
-            rewrite H1.
-            eapply Rle_trans; eauto.
-            unfold Qpower. unfold Qpower_positive.
-            assert (pow_pos Qmult (2#1) 53 = 9007199254740992 # 1 )
-              by (vm_compute; auto).
-            rewrite H12. rewrite Q2R_inv; try lra.
+          - cbn; lra.
           - unfold perturb, evalBinop.
             repeat rewrite B2Q_B2R_eq; try auto.
             rewrite <- round_eq. rewrite <- mult_round; auto.
@@ -860,8 +831,8 @@ Proof.
         rewrite B2Q_B2R_eq; try auto.
         unfold dmode; rewrite div_round.
         eapply Binop_dist' with (delta:=0%R); eauto.
-        rewrite Rabs_R0; apply mTypeToQ_pos_R.
-        unfold perturb, evalBinop.
+        rewrite Rabs_R0; apply mTypeToR_pos_R.
+        unfold perturb, evalBinop; cbn.
         repeat rewrite B2Q_B2R_eq; try auto; lra.
         rewrite finite_e1 in finite_res; auto.
       * simpl in *.
@@ -878,14 +849,7 @@ Proof.
           rewrite B2Q_B2R_eq; try auto.
           unfold dmode.
           eapply Binop_dist' with (delta:=eps); eauto.
-          - unfold mTypeToQ.
-            assert (join M64 M64 = M64) by (vm_compute; auto).
-            rewrite H1.
-            eapply Rle_trans; eauto.
-            unfold Qpower. unfold Qpower_positive.
-            assert (pow_pos Qmult (2#1) 53 = 9007199254740992 # 1 )
-              by (vm_compute; auto).
-            rewrite H12. rewrite Q2R_inv; try lra.
+          - cbn; lra.
           - unfold perturb, evalBinop.
             repeat rewrite B2Q_B2R_eq; try auto.
             rewrite <- round_eq. rewrite <- div_round; auto.

coq/Infra/MachineType.v

@@ -4,13 +4,6 @@
   @author: Raphael Monat
   @maintainer: Heiko Becker
  **)
-(* From Coq *)
-(*      Require Import QArith.QArith QArith.Qminmax QArith.Qabs QArith.Qpower *)
-(*      QArith.Qreals Reals.Reals micromega.Psatz. *)
-(* From Flover Require Import Infra.RealRationalProps Infra.Ltacs. *)
-
-(* <<<<<<< ours *)
-(* ======= *)
 From Coq.QArith
      Require Import Qpower.
 
@@ -31,6 +24,20 @@ Inductive mType: Type := M0 | M16 | M32 | M64
 (**
   Compute a machine epsilon from a  machine types in Q
 **)
+Definition mTypeToR (m:mType) :R :=
+  match m with
+  | M0 => 0%R
+  | M16 => 1 / 2^11
+  | M32 => 1/ 2^24
+  | M64 => 1/ 2^53
+  | F w f => 1/ 2^(Pos.to_nat f)
+  (*
+  (* the epsilons below match what is used internally in Daisy,
+  although these value do not match the IEEE standard *)
+  | M128 => (Qpower (2#1) (Zneg 105))
+  | M256 => (Qpower (2#1) (Zneg 211)) *)
+  end.
+
 Definition mTypeToQ (m:mType) :Q :=
   match m with
   | M0 => 0
@@ -45,19 +52,104 @@ Definition mTypeToQ (m:mType) :Q :=
   | M256 => (Qpower (2#1) (Zneg 211)) *)
   end.
 
+Definition computeErrorR v m :R :=
+  match m with
+  |M0 => 0
+  |F w f => mTypeToR m
+  |_ => Rabs v * mTypeToR m
+  end.
+
+Definition computeErrorQ v m :Q :=
+  match m with
+  |M0 => 0
+  |F w f => mTypeToQ m
+  |_ => Qabs v * mTypeToQ m
+  end.
+
+Lemma Pos_pow_1_l p:
+  Pos.pow 1 p = 1%positive.
+Proof.
+  induction p; unfold Pos.pow in *; cbn in *; try auto.
+  all: repeat rewrite IHp; auto.
+Qed.
+
+Lemma mTypeToQ_mTypeToR m :
+  Q2R (mTypeToQ m) = mTypeToR m.
+Proof.
+  destruct m; cbn; try auto using Q2R0_is_0; try (unfold Q2R; simpl; lra).
+  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.
+  - hnf; intros power_0.
+    rewrite Qpower_decomp in *.
+    unfold Qeq in *; simpl in *.
+    pose proof (Zpow_facts.Zpower_pos_pos 2 f) as Zpower_pos.
+    assert (0 <2)%Z as pos2 by (omega).
+    specialize (Zpower_pos pos2).
+    rewrite Z.mul_1_r in *.
+    rewrite power_0 in *. inversion Zpower_pos.
+Qed.
+
+Arguments mTypeToR _/.
 Arguments mTypeToQ _/.
 
-Lemma mTypeToQ_pos_Q:
-  forall m, 0 <= mTypeToQ m.
+Lemma computeErrorQ_computeErrorR m v:
+  Q2R (computeErrorQ v m) = computeErrorR (Q2R v) m.
 Proof.
-  intro e.
-  case_eq e; intros;
-    unfold mTypeToQ; try (apply Qle_bool_iff; auto; fail).
-  apply Qpower_pos; lra.
+  destruct m; unfold computeErrorQ, computeErrorR; try lra.
+  all: try rewrite Q2R_mult; rewrite mTypeToQ_mTypeToR; try auto.
+  all: f_equal; try auto.
+  all: rewrite Rabs_eq_Qabs; auto.
 Qed.
 
-Lemma mTypeToQ_pos_R :
-  forall m, (0 <= Q2R (mTypeToQ m))%R.
+Lemma computeErrorR_up (v a b:R) m:
+  (Rabs v <= RmaxAbsFun (a,b))%R ->
+  (computeErrorR v m <= computeErrorR (RmaxAbsFun (a,b)) m)%R.
+Proof.
+  intros.
+  unfold computeErrorR; destruct m; try lra.
+  all:apply Rmult_le_compat_r; try auto using mTypeToR_pos_R.
+  all:unfold RmaxAbsFun in *.
+  all:setoid_rewrite Rabs_right at 2; try auto.
+  all:apply Rle_ge; rewrite Rmax_Rle; auto using Rabs_pos.
+Qed.
+
+Open Scope R_scope.
+
+Lemma mTypeToR_pos_R m:
+  0 <= mTypeToR m.
+Proof.
+  destruct m; simpl; try lra.
+  unfold Rdiv.
+  apply Rmult_le_pos; try lra.
+  hnf; left; apply Rinv_0_lt_compat.
+  apply pow_lt; lra.
+Qed.
+
+Close Scope R_scope.
+
+Lemma mTypeToQ_pos_Q m:
+  0 <= mTypeToQ m.
+Proof.
+  destruct m; simpl; cbn; try lra.
+  apply Qinv_le_0_compat.
+  apply Qpower_pos_positive.
+  lra.
+Qed.
+
+Lemma mTypeToQ_pos_R m:
+  (0 <= Q2R (mTypeToQ m))%R.
 Proof.
   intros *.
   rewrite <- Q2R0_is_0.
@@ -134,7 +226,7 @@ Qed.
 Definition isMorePrecise (m1:mType) (m2:mType) :=
   match m1, m2 with
   |M0, _ => true
-  | F w1 f1, F w2 f2 => (w1 <=? w2)%positive && (f1 <=? f2)%positive
+  | F w1 f1, F w2 f2 => (w1 <=? w2)%positive (*&& (f1 <=? f2)%positive *)
   | F w f, _ => false
   | _ , F w f => false
   | _, _ => Qle_bool (mTypeToQ m1) (mTypeToQ m2)
@@ -145,7 +237,7 @@ Definition isMorePrecise (m1:mType) (m2:mType) :=
 Definition morePrecise (m1:mType) (m2:mType) :=
   match m1, m2 with
   | M0, _ => true
-  | F w1 f1, F w2 f2 => (w1 <=? w2)%positive && (f1 <=? f2)%positive
+  | F w1 f1, F w2 f2 => (w1 <=? w2)%positive (*&& (f1 <=? f2)%positive*)
   | _ , F w f => false
   | F w f, _ => false
   | M16, M16 => true
@@ -156,19 +248,19 @@ 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_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 ->
@@ -177,10 +269,10 @@ Lemma morePrecise_trans m1 m2 m3:
 Proof.
   destruct m1; destruct m2; destruct m3; simpl; auto;
     intros le1 le2; try congruence.
-  andb_to_prop le1; andb_to_prop le2.
-  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;
+  (* andb_to_prop le1; andb_to_prop le2. *)
+  apply Pos.leb_le in le1; apply Pos.leb_le in le2.
+    (* apply Pos.leb_le in L0; apply Pos.leb_le in R0. *)
+  (* split_bool; *)
     apply Pos.leb_le;
   eapply Pos.le_trans; eauto.
 Qed.
@@ -195,7 +287,7 @@ Lemma isMorePrecise_refl (m:mType) :
   isMorePrecise m m = true.
 Proof.
   unfold isMorePrecise; destruct m; simpl; try auto.
-  split_bool;
+  (* split_bool; *)
   apply Pos.leb_le; apply Pos.le_refl.
 Qed.
 
@@ -306,4 +398,14 @@ Definition validValue (v:Q) (m:mType) :=
   match m with
   | M0 => true
   | _ => Qle_bool (Qabs v) (maxValue m)
-  end.
\ No newline at end of file
+  end.
+
+Lemma no_underflow_fixed_point v f w:
+  Denormal v (F w f) -> False.
+Proof.
+  unfold Denormal, minValue_pos.
+  intros [abs_le non_zero].
+  rewrite Q2R0_is_0 in *.
+  unfold Rabs in abs_le.
+  destruct (Rcase_abs v); lra.
+Qed.

coq/Infra/PosSimps.v

-Require Import Coq.PArith.PArith Coq.QArith.QArith Recdef.
-
-Open Scope positive_scope.
-
-Function splitFraction (num:positive) (den:positive)
-         {measure Pos.to_nat num}
-  : option (positive * positive * positive) :=
-  if (num <=? den)
-  then None
-  else
-    match splitFraction (num-den) (den) with
-    |None => Some (1%positive, (num-den), den)
-    |Some (p, num, den) => Some (p + 1, num, den)
-    end.
-Proof.
-  intros.
-  rewrite <- Pos2Nat.inj_lt.
-  rewrite Pos.leb_gt in * |-.
-  rewrite Pos.lt_iff_add.
-  eexists.
-  rewrite Pos.sub_add; auto.
-Defined.
-
-Definition fractionBits (word_size:positive) (val:Q) :=
-  match val with
-  | Qmake num den =>
-    match num with
-    | Z0 => word_size
-    | Zpos x =>
-      match splitFraction x den with
-      |Some (full, num, den) =>
-       word_size - Pos.of_nat (Pos.size_nat full)
-      |None =>
-       word_size
-      end
-    | Zneg x =>
-      match splitFraction x den with
-      |Some (full, num, den) =>
-       word_size - Pos.of_nat (Pos.size_nat full)
-      |None =>
-       word_size
-      end
-    end
-  end.
-
-Close Scope positive_scope.
\ No newline at end of file

coq/Infra/RationalSimps.v

@@ -2,7 +2,7 @@
   Some simplification properties of rationals, not proven in the Standard Library
  **)
 From Coq.QArith
-     Require Export QArith Qminmax Qabs.
+     Require Export QArith Qminmax Qabs Qround.
 From Coq
      Require Export micromega.Psatz.
 
@@ -80,9 +80,16 @@ Proof.
     + auto.
 Qed.
 
-
 Lemma Qeq_bool_refl v:
   (Qeq_bool v v = true).
 Proof.
   apply Qeq_bool_iff; lra.
-Qed.
\ No newline at end of file
+Qed.
+
+Lemma Qabs_0_impl_eq (d:Q):
+  Qabs d <= 0 -> d == 0.
+Proof.
+  intros abs_leq_0.
+  rewrite Qabs_Qle_condition in abs_leq_0.
+  lra.
+Qed.

coq/IntervalValidation.v

@@ -196,9 +196,9 @@ Proof.
       * lra.
   - Flover_compute; canonize_hyps; simpl in *.
     kill_trivial_exists.
-    exists (perturb (Q2R v) 0).
-    split; [auto| split].
-    + econstructor; try eauto. apply Rabs_0_equiv.
+    exists (perturb (Q2R v) M0 0).
+    split; [eauto| split].
+    + econstructor; try eauto. cbn. rewrite Rabs_R0; lra.
     + unfold perturb; simpl; lra.
   - Flover_compute; simpl in *; try congruence.
     destruct IHf as [iv_f [err_f [vF [iveq_f [eval_f valid_bounds_f]]]]];
@@ -215,16 +215,16 @@ Proof.
     + rename L0 into nodiv0.
       apply le_neq_bool_to_lt_prop in nodiv0.
       kill_trivial_exists.
-      exists (perturb (evalUnop Inv vF) 0); split;
+      exists (perturb (evalUnop Inv vF) M0 0); split;
         [destruct i; auto | split].
-      * econstructor; eauto; try apply Rabs_0_equiv.
+      * econstructor; eauto.
+        { simpl. rewrite Rabs_R0; lra. }
         (* Absence of division by zero *)
-        hnf. destruct nodiv0 as [nodiv0 | nodiv0]; apply Qlt_Rlt in nodiv0;
-               rewrite Q2R0_is_0 in nodiv0; lra.
+        { hnf. destruct nodiv0 as [nodiv0 | nodiv0]; apply Qlt_Rlt in nodiv0;
+               rewrite Q2R0_is_0 in nodiv0; lra. }
       * canonize_hyps.
         pose proof (interval_inversion_valid ((Q2R (fst iv_f)),(Q2R (snd iv_f))) (a :=vF)) as inv_valid.
          unfold invertInterval in inv_valid; simpl in *.
-         rewrite delta_0_deterministic; [| rewrite Rbasic_fun.Rabs_R0; lra].
          destruct inv_valid; try auto.
          { destruct nodiv0; rewrite <- Q2R0_is_0; [left | right]; apply Qlt_Rlt; auto. }
          { split; eapply Rle_trans.
@@ -262,12 +262,13 @@ Proof.
     assert (M0 = join M0 M0) as M0_join by (cbv; auto);
       rewrite M0_join.
     kill_trivial_exists.
-    exists (perturb (evalBinop b vF1 vF2) 0);
+    exists (perturb (evalBinop b vF1 vF2) M0 0);
       split; [destruct i; auto | ].
     inversion env1; inversion env2; subst.
       destruct b; simpl in *.
     * split;
-        [econstructor; try congruence; apply Rabs_0_equiv | ].
+        [eapply Binop_dist' with (delta := 0%R); eauto; try congruence;
+         rewrite Rabs_R0; cbn; lra|].
       pose proof (interval_addition_valid ((Q2R (fst iv_f1)), Q2R (snd iv_f1))
                                           (Q2R (fst iv_f2), Q2R (snd iv_f2)))
         as valid_add.
@@ -279,7 +280,8 @@ Proof.
         rewrite <- Q2R_min4, <- Q2R_max4 in *.
       unfold perturb. lra.
     * split;
-        [econstructor; try congruence; apply Rabs_0_equiv |].
+        [eapply Binop_dist' with (delta := 0%R); eauto; try congruence;
+         rewrite Rabs_R0; cbn; lra|].
       pose proof (interval_subtraction_valid ((Q2R (fst iv_f1)), Q2R (snd iv_f1))
                                              (Q2R (fst iv_f2), Q2R (snd iv_f2)))
         as valid_sub.
@@ -292,7 +294,8 @@ Proof.
         rewrite <- Q2R_min4, <- Q2R_max4 in *.
       unfold perturb; lra.
     * split;
-        [ econstructor; try congruence; apply Rabs_0_equiv |].
+        [eapply Binop_dist' with (delta := 0%R); eauto; try congruence;
+         rewrite Rabs_R0; cbn; lra|].
       pose proof (interval_multiplication_valid ((Q2R (fst iv_f1)), Q2R (snd iv_f1))
                                                 (Q2R (fst iv_f2), Q2R (snd iv_f2)))
         as valid_mul.
@@ -307,7 +310,8 @@ Proof.
       canonize_hyps.
       apply le_neq_bool_to_lt_prop in L.
       split;
-        [ econstructor; try congruence; try apply Rabs_0_equiv | ].
+        [eapply Binop_dist' with (delta := 0%R); eauto; try congruence;
+         try rewrite Rabs_R0; cbn; try lra|].
       (* No division by zero proof *)
       { hnf; intros.
         destruct L as [L | L]; apply Qlt_Rlt in L; rewrite Q2R0_is_0 in L; lra. }
@@ -339,10 +343,10 @@ Proof.
     assert (M0 = join3 M0 M0 M0) as M0_join by (cbv; auto);
       rewrite M0_join.
     kill_trivial_exists.
-    exists (perturb (evalFma vF1 vF2 vF3) 0); split; try auto.
+    exists (perturb (evalFma vF1 vF2 vF3) M0 0); split; try auto.
     inversion env1; inversion env2; inversion env3; subst.
     split; [auto | ].
-    * econstructor; try congruence; apply Rabs_0_equiv.
+    * eapply Fma_dist' with (delta := 0%R); eauto; try congruence; cbn; rewrite Rabs_R0; lra.
     * pose proof (interval_multiplication_valid (Q2R (fst iv_f2),Q2R (snd iv_f2)) (Q2R (fst iv_f3), Q2R (snd iv_f3))) as valid_mul.
       specialize (valid_mul vF2 vF3 valid_f2 valid_f3).
       remember (multInterval (Q2R (fst iv_f2), Q2R (snd iv_f2)) (Q2R (fst iv_f3), Q2R (snd iv_f3))) as iv_f23prod.
@@ -365,9 +369,10 @@ Proof.
       try auto.
     inversion env_f; subst.
     kill_trivial_exists.
-    exists (perturb vF 0).
+    exists (perturb vF M0 0).
     split; [destruct i; try auto |].
-    split; [try econstructor; try eauto; try apply Rabs_0_equiv; unfold isMorePrecise; auto |].
+    split; [eapply Downcast_dist'; try eauto; cbn; try rewrite Rabs_R0 |];
+      try lra; try auto.
     unfold isSupersetIntv in *; andb_to_prop R.
     canonize_hyps; simpl in *.
     unfold perturb; lra.

coq/OrderedExpressions.v

 From Coq
-Require Import QArith.QArith Structures.Orders.
+     Require Import QArith.QArith Structures.Orders.
 
-Require Import Flover.Infra.RealRationalProps Flover.Infra.RationalSimps
-               Flover.Infra.Ltacs Flover.Expressions.
+From Flover
+     Require Import Infra.RealRationalProps Infra.RationalSimps Infra.Ltacs
+     Expressions.
 
 Module Type OrderType := Coq.Structures.Orders.OrderedType.
 
@@ -200,8 +201,11 @@ Module ExprOrderedType (V_ordered:OrderType) <: OrderType.
       + destruct (morePrecise m m0) eqn:?;