Commit da70f298 authored by Heiko Becker's avatar Heiko Becker

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.
parent 85bbd305
(**
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.
......
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
(* 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.
......
......@@ -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.
......
......@@ -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.
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
......@@ -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.
......@@ -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