Commit 6f207ee1 authored by Heiko Becker's avatar Heiko Becker
Browse files

Certificate checking now with division in Coq

parent 5f3ea9f0
...@@ -30,7 +30,15 @@ Fixpoint validErrorbound (e:exp Q) (env:analysisResult) := ...@@ -30,7 +30,15 @@ Fixpoint validErrorbound (e:exp Q) (env:analysisResult) :=
| Plus => Qleb (err1 + err2 + (maxAbs (addIntv errIve1 errIve2)) * RationalSimps.machineEpsilon) err | Plus => Qleb (err1 + err2 + (maxAbs (addIntv errIve1 errIve2)) * RationalSimps.machineEpsilon) err
| Sub => Qleb (err1 + err2 + (maxAbs (subtractIntv errIve1 errIve2)) * RationalSimps.machineEpsilon) err | Sub => Qleb (err1 + err2 + (maxAbs (subtractIntv errIve1 errIve2)) * RationalSimps.machineEpsilon) err
| Mult => Qleb ((upperBoundE1 * err2 + upperBoundE2 * err1 + err1 * err2) + (maxAbs (multIntv errIve1 errIve2)) * RationalSimps.machineEpsilon) err | Mult => Qleb ((upperBoundE1 * err2 + upperBoundE2 * err1 + err1 * err2) + (maxAbs (multIntv errIve1 errIve2)) * RationalSimps.machineEpsilon) err
| Div => Qleb ((maxAbs (subtractIntv (divideIntv ive1 ive2) (divideIntv errIve1 errIve2))) + (maxAbs (divideIntv errIve1 errIve2)) * RationalSimps.machineEpsilon) err | Div => let nodiv0_fl := orb
(andb (Qleb (ivhi errIve2) 0) (negb (Qeq_bool (ivhi errIve2) 0)))
(andb (Qleb 0 (ivlo errIve2)) (negb (Qeq_bool (ivlo errIve2) 0))) in
if nodiv0_fl
then Qleb
((maxAbs (subtractIntv (divideIntv ive1 ive2) (divideIntv errIve1 errIve2)))
+ (maxAbs (divideIntv errIve1 errIve2)) * RationalSimps.machineEpsilon)
err
else false
end end
in andb (andb rec errPos) theVal in andb (andb rec errPos) theVal
end. end.
...@@ -1028,7 +1036,6 @@ Proof. ...@@ -1028,7 +1036,6 @@ Proof.
repeat rewrite Q2R_plus; auto. repeat rewrite Q2R_plus; auto.
Qed. Qed.
<<<<<<< HEAD
Lemma validErrorboundCorrectDiv cenv absenv (e1:exp Q) (e2:exp Q) (nR nR1 nR2 nF nF1 nF2 :R) (e err1 err2 :error) (alo ahi e1lo e1hi e2lo e2hi:Q) P : Lemma validErrorboundCorrectDiv cenv absenv (e1:exp Q) (e2:exp Q) (nR nR1 nR2 nF nF1 nF2 :R) (e err1 err2 :error) (alo ahi e1lo e1hi e2lo e2hi:Q) P :
precondValidForExec P cenv -> precondValidForExec P cenv ->
eval_exp 0%R cenv (toRExp e1) nR1 -> eval_exp 0%R cenv (toRExp e1) nR1 ->
...@@ -1074,72 +1081,155 @@ Proof. ...@@ -1074,72 +1081,155 @@ Proof.
assert (0 <= Q2R err1)%R as err1_pos by (apply (err_always_positive e1 absenv (e1lo,e1hi) err1); auto). assert (0 <= Q2R err1)%R as err1_pos by (apply (err_always_positive e1 absenv (e1lo,e1hi) err1); auto).
assert (0 <= Q2R err2)%R as err2_pos by (apply (err_always_positive e2 absenv (e2lo,e2hi) err2); auto). assert (0 <= Q2R err2)%R as err2_pos by (apply (err_always_positive e2 absenv (e2lo,e2hi) err2); auto).
clear valid_err1 valid_err2. clear valid_err1 valid_err2.
apply Qle_bool_iff in valid_error. assert (Qleb (ivhi (widenIntv (e2lo, e2hi) err2)) 0 && negb (Qeq_bool (ivhi (widenIntv (e2lo, e2hi) err2)) 0)
apply Qle_Rle in valid_error. || Qleb 0 (ivlo (widenIntv (e2lo, e2hi) err2)) && negb (Qeq_bool (ivlo (widenIntv (e2lo, e2hi) err2)) 0)
rewrite Q2R_plus, Q2R_mult in valid_error. = true) as nodiv0_fl.
eapply Rle_trans. - case_eq (Qleb (ivhi (widenIntv (e2lo, e2hi) err2)) 0 && negb (Qeq_bool (ivhi (widenIntv (e2lo, e2hi) err2)) 0)
Focus 2. || Qleb 0 (ivlo (widenIntv (e2lo, e2hi) err2)) && negb (Qeq_bool (ivlo (widenIntv (e2lo, e2hi) err2)) 0));
apply valid_error. intros cond_val; rewrite cond_val in valid_error; auto.
eapply Rplus_le_compat. - rewrite nodiv0_fl in valid_error.
- (* Similar to other goal *) pose proof (le_neq_bool_to_lt_prop _ _ nodiv0_fl) as nodiv0_fl_lt.
remember apply Qle_bool_iff in valid_error.
(subtractIntv (divideIntv (e1lo, e1hi) (e2lo, e2hi)) apply Qle_Rle in valid_error.
(divideIntv (widenIntv (e1lo, e1hi) err1) rewrite Q2R_plus, Q2R_mult in valid_error.
(widenIntv (e2lo, e2hi) err2))) as iv. pose proof (validBoundsDiv_uneq_zero e1 e2 absenv P e2lo e2hi err2 absenv_e2 valid_intv) as nodiv0_rl.
iv_assert iv iv_unf. unfold validIntervalbounds in valid_intv.
destruct iv_unf as [ivl [ivh iv_unf]]. apply Is_true_eq_left in valid_intv.
rewrite iv_unf. rewrite absenv_div, absenv_e1, absenv_e2 in valid_intv.
rewrite <- maxAbs_impl_RmaxAbs. apply andb_prop_elim in valid_intv.
assert (ivlo iv = ivl) by (rewrite iv_unf; auto). destruct valid_intv as [valid_rec valid_div].
assert (ivhi iv = ivh) by (rewrite iv_unf; auto). apply andb_prop_elim in valid_rec; apply andb_prop_elim in valid_div.
rewrite <- H, <- H0. destruct valid_div as [valid_div _].
admit. (* By validity of IV, monotonicity *) destruct valid_rec as [valid_e1 valid_e2];
- apply Rmult_le_compat_r. apply Is_true_eq_true in valid_e1; apply Is_true_eq_true in valid_e2.
+ apply mEps_geq_zero. pose proof (validIntervalbounds_sound _ _ _ _ _ p_valid valid_e1 e1_real) as valid_bounds_e1.
+ remember (divideIntv (widenIntv (e1lo, e1hi) err1) (widenIntv (e2lo, e2hi) err2)) as iv. rewrite absenv_e1 in valid_bounds_e1.
iv_assert iv iv_unf. simpl in valid_bounds_e1.
destruct iv_unf as [ivl [ivh iv_unf]]. pose proof (validIntervalbounds_sound _ _ _ _ _ p_valid valid_e2 e2_real) as valid_bounds_e2.
rewrite iv_unf. rewrite absenv_e2 in valid_bounds_e2.
rewrite <- maxAbs_impl_RmaxAbs. simpl in valid_bounds_e2.
assert (ivlo iv = ivl) by (rewrite iv_unf; auto). clear valid_e1 valid_e2 nodiv0_fl.
assert (ivhi iv = ivh) by (rewrite iv_unf; auto). pose proof (distance_gives_iv nR1 nF1 (Q2R err1) (Q2R e1lo, Q2R e1hi) valid_bounds_e1 err1_bounded) as nF1_bounded.
rewrite <- H, <- H0. pose proof (distance_gives_iv nR2 nF2 (Q2R err2) (Q2R e2lo, Q2R e2hi) valid_bounds_e2 err2_bounded) as nF2_bounded.
admit. (* assert (IntervalArith.contained (nR1 / nR2)%R (divideInterval (Q2R e1lo, Q2R e1hi) (Q2R e2lo, Q2R e2hi))) as real_div_contained.
assert (validIntervalbounds_sound _ _ _ _ _ p_valid valid_iv_e1 e1_real) as valid_bounds_e1 by admit. + apply IntervalArith.divisionIsValid; simpl; try auto.
rewrite absenv_e1 in valid_bounds_e1. destruct nodiv0_rl as [A | A]; apply Qlt_Rlt in A; rewrite <- Q2R0_is_0; auto.
simpl in valid_bounds_e1. + assert (IntervalArith.contained (nF1 / nF2)%R (divideInterval (widenInterval (Q2R e1lo, Q2R e1hi) (Q2R err1)) (widenInterval (Q2R e2lo, Q2R e2hi) (Q2R err2)))) as float_div_contained.
pose proof (distance_gives_iv nR1 nF1 (Q2R err1) (Q2R e1lo, Q2R e1hi) valid_bounds_e1 err1_bounded). * apply IntervalArith.divisionIsValid; simpl; try auto.
pose proof (validIntervalbounds_sound _ _ _ _ _ p_valid valid_iv_e2 e2_real) as valid_bounds_e2. unfold widenIntv in nodiv0_fl_lt; simpl in nodiv0_fl_lt.
rewrite absenv_e2 in valid_bounds_e2. destruct nodiv0_fl_lt as [A | A];
simpl in valid_bounds_e2. apply Qlt_Rlt in A; rewrite <- Q2R0_is_0; rewrite <- Q2R_plus;
pose proof (distance_gives_iv nR2 nF2 (Q2R err2) (Q2R e2lo, Q2R e2hi) valid_bounds_e2 err2_bounded). rewrite <- Q2R_minus; auto.
pose proof (IntervalArith.interval_multiplication_valid _ _ _ _ H1 H2). * pose proof (IntervalArith.subtractionIsValid _ _ (nR1 / nR2)%R _ real_div_contained float_div_contained) as contained_prop_error.
unfold IntervalArith.contained in H3. eapply Rle_trans.
destruct H3. Focus 2.
unfold RmaxAbsFun. apply valid_error.
apply Rmult_le_compat_r. eapply Rplus_le_compat.
apply mEps_geq_zero. { (* Similar to other goal *)
apply RmaxAbs; subst; simpl in *. apply contained_leq_maxAbs in contained_prop_error.
- rewrite Q2R_min4. rewrite <- maxAbs_impl_RmaxAbs_iv.
repeat rewrite Q2R_mult; assert (Q2RP
repeat rewrite Q2R_minus; (subtractIntv (divideIntv (e1lo, e1hi) (e2lo, e2hi))
repeat rewrite Q2R_plus; auto. (divideIntv (widenIntv (e1lo, e1hi) err1) (widenIntv (e2lo, e2hi) err2))) =
- rewrite Q2R_max4. subtractInterval (divideInterval (Q2R e1lo, Q2R e1hi) (Q2R e2lo, Q2R e2hi))
repeat rewrite Q2R_mult; (divideInterval (widenInterval (Q2R e1lo, Q2R e1hi) (Q2R err1))
repeat rewrite Q2R_minus; (widenInterval (Q2R e2lo, Q2R e2hi) (Q2R err2)))).
repeat rewrite Q2R_plus; auto. - unfold widenIntv in nodiv0_fl_lt; simpl in nodiv0_fl_lt.
Qed. *) unfold IntervalArith.widenInterval, IntervalArith.contained in nF2_bounded; simpl in nF2_bounded.
Admitted. unfold subtractInterval, divideInterval, widenInterval, addInterval, multInterval, absIntvUpd; simpl.
rewrite Q2R_min4, Q2R_max4.
repeat rewrite Q2R_plus.
repeat rewrite Q2R_opp.
repeat rewrite Q2R_min4.
repeat rewrite Q2R_max4.
repeat rewrite Q2R_mult.
repeat rewrite Q2R_inv; try hnf; intros.
repeat rewrite Q2R_plus, Q2R_minus.
auto.
+ destruct nodiv0_fl_lt.
* apply Qlt_Rlt in H0.
rewrite <- Q2R_minus in nF2_bounded.
rewrite <- Q2R_plus in nF2_bounded.
assert (Q2R (e2lo- err2) <= Q2R (e2hi + err2))%R by lra.
apply Rle_Qle in H1.
rewrite H in H1.
apply Qle_Rle in H1.
lra.
* rewrite H in H0; lra.
+ destruct nodiv0_fl_lt.
* rewrite H in H0; lra.
* apply Qlt_Rlt in H0.
rewrite <- Q2R_minus in nF2_bounded.
rewrite <- Q2R_plus in nF2_bounded.
assert (Q2R (e2lo- err2) <= Q2R (e2hi + err2))%R by lra.
apply Rle_Qle in H1.
rewrite H in H1.
apply Qle_Rle in H1.
lra.
+ destruct nodiv0_rl.
* apply Qlt_Rlt in H0.
rewrite <- Q2R_minus in nF2_bounded.
rewrite <- Q2R_plus in nF2_bounded.
assert (Q2R e2lo <= Q2R e2hi)%R by lra.
apply Rle_Qle in H1.
rewrite H in H1.
apply Qle_Rle in H1.
lra.
* rewrite H in H0; lra.
+ destruct nodiv0_rl.
* rewrite H in H0; lra.
* apply Qlt_Rlt in H0.
rewrite <- Q2R_minus in nF2_bounded.
rewrite <- Q2R_plus in nF2_bounded.
assert (Q2R e2lo <= Q2R e2hi)%R by lra.
apply Rle_Qle in H1.
rewrite H in H1.
apply Qle_Rle in H1.
lra.
- rewrite H; auto. }
{ apply Rmult_le_compat_r.
- apply mEps_geq_zero.
- apply contained_leq_maxAbs in float_div_contained.
rewrite <- maxAbs_impl_RmaxAbs_iv.
assert (Q2RP (divideIntv (widenIntv (e1lo, e1hi) err1) (widenIntv (e2lo, e2hi) err2)) =
divideInterval (widenInterval (Q2R e1lo, Q2R e1hi) (Q2R err1))
(widenInterval (Q2R e2lo, Q2R e2hi) (Q2R err2))).
+ unfold widenIntv in nodiv0_fl_lt; simpl in nodiv0_fl_lt.
unfold IntervalArith.widenInterval, IntervalArith.contained in nF2_bounded; simpl in nF2_bounded.
unfold subtractInterval, divideInterval, widenInterval, addInterval, multInterval, absIntvUpd; simpl.
rewrite Q2R_min4, Q2R_max4.
repeat rewrite Q2R_mult.
repeat rewrite Q2R_inv; try hnf; intros.
repeat rewrite Q2R_minus, Q2R_plus; auto.
* destruct nodiv0_fl_lt.
{ apply Qlt_Rlt in H0.
rewrite <- Q2R_minus in nF2_bounded.
rewrite <- Q2R_plus in nF2_bounded.
assert (Q2R (e2lo- err2) <= Q2R (e2hi + err2))%R by lra.
apply Rle_Qle in H1.
rewrite H in H1.
apply Qle_Rle in H1.
lra. }
{ rewrite H in H0; lra. }
* destruct nodiv0_fl_lt.
{ rewrite H in H0; lra. }
{ apply Qlt_Rlt in H0.
rewrite <- Q2R_minus in nF2_bounded.
rewrite <- Q2R_plus in nF2_bounded.
assert (Q2R (e2lo- err2) <= Q2R (e2hi + err2))%R by lra.
apply Rle_Qle in H1.
rewrite H in H1.
apply Qle_Rle in H1.
lra. }
+ rewrite H; auto. }
Qed.
Lemma validErrorbound_sound (e:exp Q):
=======
(** (**
Soundness theorem for the error bound validator. Soundness theorem for the error bound validator.
Proof is by induction on the expression e. Proof is by induction on the expression e.
Each case requires the application of one of the soundness lemmata proven before Each case requires the application of one of the soundness lemmata proven before
**) **)
Theorem validErrorbound_sound (e:exp Q): Theorem validErrorbound_sound (e:exp Q):
>>>>>>> certification
forall cenv absenv nR nF err P elo ehi, forall cenv absenv nR nF err P elo ehi,
precondValidForExec P cenv -> precondValidForExec P cenv ->
eval_exp 0%R cenv (toRExp e) nR -> eval_exp 0%R cenv (toRExp e) nR ->
......
...@@ -39,3 +39,19 @@ Proof. ...@@ -39,3 +39,19 @@ Proof.
setoid_rewrite Qmult_comm at 1 2. setoid_rewrite Qmult_comm at 1 2.
apply Qmult_le_compat_r; auto. apply Qmult_le_compat_r; auto.
Qed. Qed.
Lemma le_neq_bool_to_lt_prop a b:
(Qleb a 0 && negb (Qeq_bool a 0) || Qleb 0 b && negb (Qeq_bool b 0)) = true ->
a < 0 \/ 0 < b.
Proof.
intros le_neq_bool.
apply Is_true_eq_left in le_neq_bool.
apply orb_prop_elim in le_neq_bool.
destruct le_neq_bool as [lt_0 | lt_0];
apply andb_prop_elim in lt_0; destruct lt_0 as [le_0 neq_0];
apply Is_true_eq_true in le_0; apply Is_true_eq_true in neq_0;
apply negb_true_iff in neq_0; apply Qeq_bool_neq in neq_0;
rewrite Qle_bool_iff in le_0;
rewrite Qle_lteq in le_0; destruct le_0 as [lt_0 | eq_0];
[ | exfalso; apply neq_0; auto | | exfalso; apply neq_0; symmetry; auto]; auto.
Qed.
\ No newline at end of file
...@@ -155,7 +155,7 @@ Proof. ...@@ -155,7 +155,7 @@ Proof.
+ apply Ropp_le_ge_contravar in H0; + apply Ropp_le_ge_contravar in H0;
repeat rewrite Ropp_involutive in H0; lra. repeat rewrite Ropp_involutive in H0; lra.
- assert (- / ivlo <= - / a)%R. - assert (- / ivlo <= - / a)%R.
+ repeat rewrite Ropp_inv_permute; try lra. + repeat rewrite Ropp_inv_permute; try lra.
eapply RIneq.Rinv_le_contravar; try lra. eapply RIneq.Rinv_le_contravar; try lra.
+ apply Ropp_le_ge_contravar in H0; + apply Ropp_le_ge_contravar in H0;
repeat rewrite Ropp_involutive in H0; lra. repeat rewrite Ropp_involutive in H0; lra.
......
...@@ -110,14 +110,8 @@ Proof. ...@@ -110,14 +110,8 @@ Proof.
apply andb_prop_elim in validBounds. apply andb_prop_elim in validBounds.
destruct validBounds as [_ validBounds]; apply andb_prop_elim in validBounds. destruct validBounds as [_ validBounds]; apply andb_prop_elim in validBounds.
destruct validBounds as [_ nodiv0]. destruct validBounds as [_ nodiv0].
apply orb_prop_elim in nodiv0. apply Is_true_eq_true in nodiv0.
destruct nodiv0 as [lt_0 | lt_0]; apply le_neq_bool_to_lt_prop; auto.
apply andb_prop_elim in lt_0; destruct lt_0 as [le_0 neq_0];
apply Is_true_eq_true in le_0; apply Is_true_eq_true in neq_0;
apply negb_true_iff in neq_0; apply Qeq_bool_neq in neq_0;
rewrite Qle_bool_iff in le_0;
rewrite Qle_lteq in le_0; destruct le_0 as [lt_0 | eq_0];
[ | exfalso; apply neq_0; auto | | exfalso; apply neq_0; symmetry; auto]; auto.
Qed. Qed.
Theorem validIntervalbounds_sound (e:exp Q): Theorem validIntervalbounds_sound (e:exp Q):
......
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