Commit 353631d9 authored by Heiko Becker's avatar Heiko Becker

Finish proving the validRanges and validRangesCmd predicates and adding them...

Finish proving the validRanges and validRangesCmd predicates and adding them to all other soundness proofs
parent 7256c32f
...@@ -3,7 +3,7 @@ Require Import Recdef. ...@@ -3,7 +3,7 @@ Require Import Recdef.
Require Import Flover.AffineForm Flover.AffineArithQ Flover.AffineArith. Require Import Flover.AffineForm Flover.AffineArithQ Flover.AffineArith.
Require Import Flover.Infra.Abbrevs Flover.Infra.RationalSimps Flover.Infra.RealRationalProps. Require Import Flover.Infra.Abbrevs Flover.Infra.RationalSimps Flover.Infra.RealRationalProps.
Require Import Flover.Infra.Ltacs Flover.Infra.RealSimps Flover.Typing Flover.ssaPrgs. Require Import Flover.Infra.Ltacs Flover.Infra.RealSimps Flover.Typing Flover.ssaPrgs.
Require Import Flover.IntervalValidation. Require Import Flover.IntervalValidation Flover.RealRangeArith.
Lemma usedVars_eq_compat e1 e2: Lemma usedVars_eq_compat e1 e2:
Q_orderedExps.eq e1 e2 -> Q_orderedExps.eq e1 e2 ->
...@@ -2104,7 +2104,7 @@ Proof. ...@@ -2104,7 +2104,7 @@ Proof.
exists ihmap, ihaf, ihvR, ihaiv, ihaerr. exists ihmap, ihaf, ihvR, ihaiv, ihaerr.
repeat split; try auto. repeat split; try auto.
+ econstructor; try eauto. + econstructor; try eauto.
eapply IntervalValidation.swap_Gamma_bstep with (Gamma1 := toRMap (updDefVars n REAL Gamma)) ; try eauto. eapply swap_Gamma_bstep with (Gamma1 := toRMap (updDefVars n REAL Gamma)) ; try eauto.
intros n1; erewrite Rmap_updVars_comm; eauto. intros n1; erewrite Rmap_updVars_comm; eauto.
+ intros e' Hnone Hsome. + intros e' Hnone Hsome.
specialize (ihchecked e'). specialize (ihchecked e').
......
...@@ -4,12 +4,12 @@ ...@@ -4,12 +4,12 @@
Running this function on the encoded analysis result gives the desired theorem Running this function on the encoded analysis result gives the desired theorem
as shown in the soundness theorem. as shown in the soundness theorem.
**) **)
Require Import Coq.Reals.Reals Coq.QArith.Qreals. From Flover
Require Import Flover.Infra.RealSimps Flover.Infra.RationalSimps Flover.Infra.RealRationalProps Flover.Infra.Ltacs. Require Import Infra.RealSimps Infra.RationalSimps Infra.RealRationalProps
Require Import Flover.RealRangeValidator Flover.RoundoffErrorValidator Flover.Environments Flover.Typing Flover.FPRangeValidator. Infra.Ltacs RealRangeArith RealRangeValidator RoundoffErrorValidator
Environments Typing FPRangeValidator ExpressionAbbrevs Commands.
Require Export Coq.QArith.QArith. Require Export Infra.ExpressionAbbrevs Flover.Commands.
Require Export Flover.Infra.ExpressionAbbrevs Flover.Commands.
(** Certificate checking function **) (** Certificate checking function **)
Definition CertificateChecker (e:expr Q) (absenv:analysisResult) (P:precond) (defVars:nat -> option mType) := Definition CertificateChecker (e:expr Q) (absenv:analysisResult) (P:precond) (defVars:nat -> option mType) :=
...@@ -68,10 +68,13 @@ Proof. ...@@ -68,10 +68,13 @@ Proof.
{ unfold vars_typed. intros; apply types_defined. set_tac. destruct H1; set_tac. { unfold vars_typed. intros; apply types_defined. set_tac. destruct H1; set_tac.
split; try auto. hnf; intros; set_tac. } split; try auto. hnf; intros; set_tac. }
rename R into validFPRanges. rename R into validFPRanges.
edestruct (RangeValidator_sound e (dVars:=NatSet.empty) (A:=absenv) (P:=P) (Gamma:=defVars) (E:=E1)) assert (validRanges e absenv E1 defVars) as valid_e.
as [iv_e [ err_e [vR [ map_e [eval_real real_bounds_e]]]]]; eauto. { eapply (RangeValidator_sound e (dVars:=NatSet.empty) (A:=absenv) (P:=P) (Gamma:=defVars) (E:=E1));
auto. }
pose proof (validRanges_single _ _ _ _ valid_e) as valid_single;
destruct valid_single as [iv_e [ err_e [vR [ map_e [eval_real real_bounds_e]]]]].
destruct iv_e as [elo ehi]. destruct iv_e as [elo ehi].
edestruct (RoundoffErrorValidator_sound e (typeMap defVars e (FloverMap.empty mType)) L approxE1E2 H0 eval_real R0 L1 H P_valid H1 map_e) as [[vF [mF eval_float]] err_bounded]; auto. edestruct (RoundoffErrorValidator_sound e (typeMap defVars e (FloverMap.empty mType)) L approxE1E2 H0 eval_real R0 valid_e H1 map_e) as [[vF [mF eval_float]] err_bounded]; auto.
exists (elo, ehi), err_e, vR, vF, mF; split; auto. exists (elo, ehi), err_e, vR, vF, mF; split; auto.
Qed. Qed.
...@@ -81,7 +84,7 @@ Definition CertificateCheckerCmd (f:cmd Q) (absenv:analysisResult) (P:precond) d ...@@ -81,7 +84,7 @@ Definition CertificateCheckerCmd (f:cmd Q) (absenv:analysisResult) (P:precond) d
then then
if (RangeValidatorCmd f absenv P NatSet.empty) && if (RangeValidatorCmd f absenv P NatSet.empty) &&
FPRangeValidatorCmd f absenv tMap NatSet.empty FPRangeValidatorCmd f absenv tMap NatSet.empty
then (validErrorboundCmd f tMap absenv NatSet.empty) then (RoundoffErrorValidatorCmd f tMap absenv NatSet.empty)
else false else false
else false. else false.
...@@ -126,12 +129,13 @@ Proof. ...@@ -126,12 +129,13 @@ Proof.
destruct H0; set_tac. } destruct H0; set_tac. }
assert (NatSet.Subset (freeVars f -- NatSet.empty) (freeVars f)) assert (NatSet.Subset (freeVars f -- NatSet.empty) (freeVars f))
as freeVars_contained by set_tac. as freeVars_contained by set_tac.
edestruct (validIntervalboundsCmd_sound) assert (validRangesCmd f absenv E1 defVars) as valid_f.
as [iv [ err [vR [map_f [eval_real bounded_real_f]]]]]; eauto. { eapply RangeValidatorCmd_sound; eauto.
unfold affine_dVars_range_valid; intros.
set_tac. }
pose proof (validRangesCmd_single _ _ _ _ valid_f) as valid_single.
destruct valid_single as [iv [ err [vR [map_f [eval_real bounded_real_f]]]]].
destruct iv as [f_lo f_hi]. destruct iv as [f_lo f_hi].
edestruct validErrorboundCmd_gives_eval as [vF [mF eval_float]]; eauto. edestruct (RoundoffErrorValidatorCmd_sound) as [[vF [mF eval_float]] ?]; eauto.
exists (f_lo, f_hi), err, vR, vF, mF; split; try auto. exists (f_lo, f_hi), err, vR, vF, mF; split; try auto.
split; try auto; split; try auto.
intros.
eapply validErrorboundCmd_sound; eauto.
Qed. Qed.
...@@ -2181,7 +2181,7 @@ Theorem validErrorboundCmd_gives_eval (f:cmd Q) : ...@@ -2181,7 +2181,7 @@ Theorem validErrorboundCmd_gives_eval (f:cmd Q) :
NatSet.Subset (NatSet.diff (Commands.freeVars f) dVars) fVars -> NatSet.Subset (NatSet.diff (Commands.freeVars f) dVars) fVars ->
bstep (toREvalCmd (toRCmd f)) E1 (toRMap defVars) vR REAL -> bstep (toREvalCmd (toRCmd f)) E1 (toRMap defVars) vR REAL ->
validErrorboundCmd f Gamma A dVars = true -> validErrorboundCmd f Gamma A dVars = true ->
validRangesCmd f A E1 (toRMap defVars) -> validRangesCmd f A E1 defVars ->
vars_typed (NatSet.union fVars dVars) defVars -> vars_typed (NatSet.union fVars dVars) defVars ->
FloverMap.find (getRetExp f) A = Some ((elo,ehi),err) -> FloverMap.find (getRetExp f) A = Some ((elo,ehi),err) ->
(exists vF m, (exists vF m,
...@@ -2241,32 +2241,12 @@ Proof. ...@@ -2241,32 +2241,12 @@ Proof.
split; try auto. } split; try auto. }
{ eapply swap_Gamma_bstep with (Gamma1 := updDefVars n REAL (toRMap defVars)); { eapply swap_Gamma_bstep with (Gamma1 := updDefVars n REAL (toRMap defVars));
eauto using Rmap_updVars_comm. } eauto using Rmap_updVars_comm. }
{ eapply valid_cont. { apply validRangesCmd_swap with (Gamma1 := updDefVars n REAL defVars).
{ intros v1 v1_mem. - intros x.
unfold updEnv. unfold toRMap, updDefVars.
case_eq (v1 =? n); intros v1_eq. destruct (x =? n) eqn:?; auto.
- apply Nat.eqb_eq in v1_eq; subst. - apply valid_cont.
exists v, (q1, q2), e1; split; try auto; split; try auto; simpl. apply swap_Gamma_eval_expr with (Gamma1 := toRMap defVars); try auto. }
destruct (validIntervalbounds_sound e (E:=E1) (Gamma:=defVars) L (fVars:=fVars))
as [iv_e' [ err_e' [vR_e [map_e [eval_real_e bounded_real_e]]]]];
eauto.
rewrite map_e in *; inversion Heqo; subst.
pose proof (meps_0_deterministic _ eval_real_e H7); subst.
simpl in *. inversion Heqo0; subst; lra.
- rewrite Nat.eqb_neq in v1_eq; set_tac.
destruct v1_mem; subst; try congruence.
apply fVars_sound ; try auto.
destruct H0; auto. }
{ intros v1 mem_fVars.
specialize (P_valid v1 mem_fVars).
unfold updEnv.
case_eq (v1 =? n); intros case_v1; try rewrite case_v1 in *; try auto.
rewrite Nat.eqb_eq in case_v1; subst.
assert (NatSet.In n (NatSet.union fVars dVars))
as in_union
by (rewrite NatSet.union_spec; auto).
rewrite <- NatSet.mem_spec in in_union.
rewrite in_union in *; congruence. }
{ intros v1 v1_mem; set_tac. { intros v1 v1_mem; set_tac.
unfold updDefVars. unfold updDefVars.
case_eq (v1 =? n); intros case_v1; try rewrite case_v1 in *; try eauto. case_eq (v1 =? n); intros case_v1; try rewrite case_v1 in *; try eauto.
...@@ -2277,16 +2257,17 @@ Proof. ...@@ -2277,16 +2257,17 @@ Proof.
rewrite Nat.eqb_neq in case_v1; congruence. } rewrite Nat.eqb_neq in case_v1; congruence. }
{ exists vF_res; exists m_res; try auto. { exists vF_res; exists m_res; try auto.
econstructor; eauto. } econstructor; eauto. }
+ destruct valid_intv as [[? ?] ?]; auto.
- inversion eval_real; subst. - inversion eval_real; subst.
unfold updEnv; simpl. unfold updEnv; simpl.
unfold validErrorboundCmd in valid_bounds. unfold validErrorboundCmd in valid_bounds.
simpl in *. destruct valid_intv.
edestruct validErrorbound_sound as [[vF [mF eval_e]] bounded_e]; eauto. edestruct validErrorbound_sound as [[vF [mF eval_e]] bounded_e]; eauto.
exists vF; exists mF; econstructor; eauto. exists vF; exists mF; econstructor; eauto.
Qed. Qed.
Theorem validErrorboundCmd_sound (f:cmd Q): Theorem validErrorboundCmd_sound (f:cmd Q):
forall A E1 E2 outVars fVars dVars vR vF mF elo ehi err P Gamma defVars, forall A E1 E2 outVars fVars dVars vR vF mF elo ehi err Gamma defVars,
typeCheckCmd f defVars Gamma = true -> typeCheckCmd f defVars Gamma = true ->
approxEnv E1 defVars A fVars dVars E2 -> approxEnv E1 defVars A fVars dVars E2 ->
ssa f (NatSet.union fVars dVars) outVars -> ssa f (NatSet.union fVars dVars) outVars ->
...@@ -2294,16 +2275,14 @@ Theorem validErrorboundCmd_sound (f:cmd Q): ...@@ -2294,16 +2275,14 @@ Theorem validErrorboundCmd_sound (f:cmd Q):
bstep (toREvalCmd (toRCmd f)) E1 (toRMap defVars) vR REAL -> bstep (toREvalCmd (toRCmd f)) E1 (toRMap defVars) vR REAL ->
bstep (toRCmd f) E2 defVars vF mF -> bstep (toRCmd f) E2 defVars vF mF ->
validErrorboundCmd f Gamma A dVars = true -> validErrorboundCmd f Gamma A dVars = true ->
validIntervalboundsCmd f A P dVars = true -> validRangesCmd f A E1 defVars ->
dVars_range_valid dVars E1 A ->
fVars_P_sound fVars E1 P ->
vars_typed (NatSet.union fVars dVars) defVars -> vars_typed (NatSet.union fVars dVars) defVars ->
FloverMap.find (getRetExp f) A = Some ((elo,ehi),err) -> FloverMap.find (getRetExp f) A = Some ((elo,ehi),err) ->
(Rabs (vR - vF) <= (Q2R err))%R. (Rabs (vR - vF) <= (Q2R err))%R.
Proof. Proof.
induction f; induction f;
intros * type_f approxc1c2 ssa_f freeVars_subset eval_real eval_float intros * type_f approxc1c2 ssa_f freeVars_subset eval_real eval_float
valid_bounds valid_intv fVars_sound P_valid types_defined A_res; valid_bounds valid_intv types_defined A_res;
cbn in *; Flover_compute; try congruence; type_conv; subst. cbn in *; Flover_compute; try congruence; type_conv; subst.
- inversion eval_real; - inversion eval_real;
inversion eval_float; inversion eval_float;
...@@ -2317,25 +2296,20 @@ Proof. ...@@ -2317,25 +2296,20 @@ Proof.
match goal with match goal with
| [H : validErrorbound _ _ _ _ = true |- _] => | [H : validErrorbound _ _ _ _ = true |- _] =>
eapply validErrorbound_sound eapply validErrorbound_sound
with (err := e2) (elo := fst(i)) (ehi:= snd(i)) in H; edestruct i; eauto; with (err := e0) (elo := fst(i)) (ehi:= snd(i)) in H; edestruct i; eauto;
destruct H as [[vFe [mFe eval_float_e]] bounded_e] destruct H as [[vFe [mFe eval_float_e]] bounded_e]
end. end.
canonize_hyps. canonize_hyps.
rename R into valid_rec. rename R into valid_rec.
rewrite (typingSoundnessExp _ _ L0 eval_float_e) in *; rewrite (typingSoundnessExp _ _ L eval_float_e) in *;
simpl in *. simpl in *.
(* destruct (Gamma (Var Q n)); try congruence. *)
(* match goal with *)
(* | [ H: _ && _ = true |- _] => andb_to_prop H *)
(* end. *)
(* type_conv. *)
apply (IHf A (updEnv n v E1) (updEnv n v0 E2) outVars fVars apply (IHf A (updEnv n v E1) (updEnv n v0 E2) outVars fVars
(NatSet.add n dVars) vR vF mF elo ehi err P Gamma (NatSet.add n dVars) vR vF mF elo ehi err Gamma
(updDefVars n m1 defVars)); (updDefVars n m1 defVars));
eauto. eauto.
+ eapply approxUpdBound; try eauto. + eapply approxUpdBound; try eauto.
simpl in *. simpl in *.
apply Rle_trans with (r2:= Q2R e2); try lra. apply Rle_trans with (r2:= Q2R e0); try lra.
eapply bounded_e; eauto. eapply bounded_e; eauto.
+ eapply ssa_equal_set; eauto. + eapply ssa_equal_set; eauto.
hnf. intros a; split; intros in_set. hnf. intros a; split; intros in_set.
...@@ -2354,34 +2328,13 @@ Proof. ...@@ -2354,34 +2328,13 @@ Proof.
split; try auto. split; try auto.
+ eapply swap_Gamma_bstep with (Gamma1 := updDefVars n REAL (toRMap defVars)); + eapply swap_Gamma_bstep with (Gamma1 := updDefVars n REAL (toRMap defVars));
eauto using Rmap_updVars_comm. eauto using Rmap_updVars_comm.
+ intros v1 v1_mem. + apply validRangesCmd_swap with (Gamma1 := updDefVars n REAL defVars).
unfold updEnv. * intros x.
case_eq (v1 =? n); intros v1_eq. unfold toRMap, updDefVars.
* apply Nat.eqb_eq in v1_eq; subst. destruct (x =? n) eqn:?; auto.
exists v, (q1,q2), e1; split; try auto; split; try auto. * destruct valid_intv as [[? valid_cont] ?].
simpl. rewrite <- R1, <- R0. apply valid_cont.
destruct (validIntervalbounds_sound e L (E:=E1) (Gamma:=defVars) (fVars:=fVars)) apply swap_Gamma_eval_expr with (Gamma1 := toRMap defVars); try auto.
as [iv_e [ err_e [ vR_e [ map_e [eval_real_e bounded_real_e]]]]];
eauto.
repeat destr_factorize.
pose proof (meps_0_deterministic _ eval_real_e H7); subst.
inversion Heqo0; subst.
simpl in *; auto.
* rewrite Nat.eqb_neq in v1_eq.
set_tac.
destruct v1_mem as [? | [? ?]].
{ exfalso; apply v1_eq; auto. }
{ apply fVars_sound ; auto. }
+ intros v1 mem_fVars.
specialize (P_valid v1 mem_fVars).
unfold updEnv.
case_eq (v1 =? n); intros case_v1; try rewrite case_v1 in *; try auto.
rewrite Nat.eqb_eq in case_v1; subst.
assert (NatSet.In n (NatSet.union fVars dVars))
as in_union
by (rewrite NatSet.union_spec; auto).
rewrite <- NatSet.mem_spec in in_union.
rewrite in_union in *; congruence.
+ intros v1 v1_mem; set_tac. + intros v1 v1_mem; set_tac.
unfold updDefVars. unfold updDefVars.
case_eq (v1 =? n); intros case_v1; try rewrite case_v1 in *; try eauto. case_eq (v1 =? n); intros case_v1; try rewrite case_v1 in *; try eauto.
...@@ -2390,10 +2343,11 @@ Proof. ...@@ -2390,10 +2343,11 @@ Proof.
destruct v1_mem as [v_fVar | v_dVar]; try auto. destruct v1_mem as [v_fVar | v_dVar]; try auto.
rewrite NatSet.add_spec in v_dVar. destruct v_dVar; try auto. rewrite NatSet.add_spec in v_dVar. destruct v_dVar; try auto.
subst; rewrite Nat.eqb_refl in case_v1; congruence. subst; rewrite Nat.eqb_refl in case_v1; congruence.
+ destruct valid_intv as [[? ?] ?]; auto.
- inversion eval_real; subst. - inversion eval_real; subst.
inversion eval_float; subst. inversion eval_float; subst.
unfold updEnv; simpl. unfold updEnv; simpl.
unfold validErrorboundCmd in valid_bounds. unfold validErrorboundCmd in valid_bounds.
simpl in *. destruct valid_intv as [? ?].
edestruct validErrorbound_sound as [[* [* eval_e]] bounded_e]; eauto. edestruct validErrorbound_sound as [[* [* eval_e]] bounded_e]; eauto.
Qed. Qed.
...@@ -55,7 +55,7 @@ Fixpoint FPRangeValidatorCmd (f:cmd Q) (A:analysisResult) typeMap dVars := ...@@ -55,7 +55,7 @@ Fixpoint FPRangeValidatorCmd (f:cmd Q) (A:analysisResult) typeMap dVars :=
Ltac prove_fprangeval m v L1 R:= Ltac prove_fprangeval m v L1 R:=
destruct m eqn:?; try auto; destruct m eqn:?; try auto;
unfold normal, Normal, validValue, Denormal in *; canonize_hyps; unfold normal, Normal, validValue, Denormal in *; canonize_hyps;
rewrite orb_true_iff in *; try rewrite orb_true_iff in *;
destruct L1; destruct R; canonize_hyps; destruct L1; destruct R; canonize_hyps;
rewrite <- Rabs_eq_Qabs in *; rewrite <- Rabs_eq_Qabs in *;
Q2R_to_head; Q2R_to_head;
...@@ -69,16 +69,14 @@ Ltac prove_fprangeval m v L1 R:= ...@@ -69,16 +69,14 @@ Ltac prove_fprangeval m v L1 R:=
destruct (Rle_lt_dec (Rabs v) (Q2R (maxValue m)))%R; lra. destruct (Rle_lt_dec (Rabs v) (Q2R (maxValue m)))%R; lra.
Theorem FPRangeValidator_sound: Theorem FPRangeValidator_sound:
forall (e:expr Q) E1 E2 Gamma v m A tMap P fVars dVars, forall (e:expr Q) E1 E2 Gamma v m A tMap fVars dVars,
approxEnv E1 Gamma A fVars dVars E2 -> approxEnv E1 Gamma A fVars dVars E2 ->
eval_expr E2 Gamma (toRExp e) v m -> eval_expr E2 Gamma (toRExp e) v m ->
typeCheck e Gamma tMap = true -> typeCheck e Gamma tMap = true ->
validIntervalbounds e A P dVars = true -> validRanges e A E1 Gamma ->
validErrorbound e tMap A dVars = true -> validErrorbound e tMap A dVars = true ->
FPRangeValidator e A tMap dVars = true -> FPRangeValidator e A tMap dVars = true ->
NatSet.Subset (NatSet.diff (usedVars e) dVars) fVars -> NatSet.Subset (NatSet.diff (usedVars e) dVars) fVars ->
dVars_range_valid dVars E1 A ->
fVars_P_sound fVars E1 P ->
vars_typed (NatSet.union fVars dVars) Gamma -> vars_typed (NatSet.union fVars dVars) Gamma ->
(forall v, NatSet.In v dVars -> (forall v, NatSet.In v dVars ->
exists vF m, E2 v = Some vF /\ FloverMap.find (Var Q v) tMap = Some m /\ validFloatValue vF m) -> exists vF m, E2 v = Some vF /\ FloverMap.find (Var Q v) tMap = Some m /\ validFloatValue vF m) ->
...@@ -91,8 +89,8 @@ Proof. ...@@ -91,8 +89,8 @@ Proof.
as type_e as type_e
by (eapply typingSoundnessExp; eauto). by (eapply typingSoundnessExp; eauto).
unfold validFloatValue. unfold validFloatValue.
edestruct (validIntervalbounds_sound e (A:=A) (P:=P)) pose proof (validRanges_single _ _ _ _ H2) as valid_e.
as [iv_e [err_e [vR[ map_e[eval_real vR_bounded]]]]]; eauto. destruct valid_e as [iv_e [err_e [vR[ map_e[eval_real vR_bounded]]]]].
destruct iv_e as [e_lo e_hi]. destruct iv_e as [e_lo e_hi].
assert (Rabs (vR - v) <= Q2R (err_e))%R. assert (Rabs (vR - v) <= Q2R (err_e))%R.
{ eapply validErrorbound_sound; eauto. } { eapply validErrorbound_sound; eauto. }
...@@ -107,17 +105,18 @@ Proof. ...@@ -107,17 +105,18 @@ Proof.
destruct e; destruct e;
unfold validFloatValue in *; cbn in *; unfold validFloatValue in *; cbn in *;
rewrite type_e in *; cbn in *. rewrite type_e in *; cbn in *.
- destruct (n mem dVars) eqn:?; simpl in *.
+ destruct (H9 n); try set_tac.
destruct H12 as [m2 [env_eq [map_eq validVal]]].
inversion H0; subst.
rewrite env_eq in H14; inversion H14; subst.
rewrite map_eq in type_e; inversion type_e; subst; auto.
+ Flover_compute.
prove_fprangeval m v L1 R.
- Flover_compute. - Flover_compute.
prove_fprangeval m v L1 R. destruct (n mem dVars) eqn:?.
+ set_tac. edestruct H7 as [? [? [? [? ?]]]]; eauto.
rewrite H10 in type_e; inversion type_e; subst.
inversion H0; subst.
rewrite H14 in H3; inversion H3; subst.
auto.
+ Flover_compute. prove_fprangeval m v L2 R.
- Flover_compute; try congruence. - Flover_compute; try congruence.
type_conv; subst.
prove_fprangeval m v L1 R.
- Flover_compute; destruct u; Flover_compute; try congruence.
type_conv; subst. type_conv; subst.
prove_fprangeval m0 v L1 R. prove_fprangeval m0 v L1 R.
- Flover_compute; try congruence. - Flover_compute; try congruence.
...@@ -132,18 +131,16 @@ Proof. ...@@ -132,18 +131,16 @@ Proof.
Qed. Qed.
Lemma FPRangeValidatorCmd_sound (f:cmd Q): Lemma FPRangeValidatorCmd_sound (f:cmd Q):
forall E1 E2 Gamma v vR m A tMap P fVars dVars outVars, forall E1 E2 Gamma v vR m A tMap fVars dVars outVars,
approxEnv E1 Gamma A fVars dVars E2 -> approxEnv E1 Gamma A fVars dVars E2 ->
ssa f (NatSet.union fVars dVars) outVars -> ssa f (NatSet.union fVars dVars) outVars ->
bstep (toREvalCmd (toRCmd f)) E1 (toRMap Gamma) vR m -> bstep (toREvalCmd (toRCmd f)) E1 (toRMap Gamma) vR m ->
bstep (toRCmd f) E2 Gamma v m -> bstep (toRCmd f) E2 Gamma v m ->
typeCheckCmd f Gamma tMap = true -> typeCheckCmd f Gamma tMap = true ->
validIntervalboundsCmd f A P dVars = true -> validRangesCmd f A E1 Gamma ->
validErrorboundCmd f tMap A dVars = true -> validErrorboundCmd f tMap A dVars = true ->
FPRangeValidatorCmd f A tMap dVars = true -> FPRangeValidatorCmd f A tMap dVars = true ->
NatSet.Subset (NatSet.diff (freeVars f) dVars) fVars -> NatSet.Subset (NatSet.diff (freeVars f) dVars) fVars ->
dVars_range_valid dVars E1 A ->
fVars_P_sound fVars E1 P ->
vars_typed (NatSet.union fVars dVars) Gamma -> vars_typed (NatSet.union fVars dVars) Gamma ->
(forall v, NatSet.In v dVars -> (forall v, NatSet.In v dVars ->
exists vF m, E2 v = Some vF /\ FloverMap.find (Var Q v) tMap = Some m /\ validFloatValue vF m) -> exists vF m, E2 v = Some vF /\ FloverMap.find (Var Q v) tMap = Some m /\ validFloatValue vF m) ->
...@@ -160,85 +157,71 @@ Proof. ...@@ -160,85 +157,71 @@ Proof.
by(eapply typingSoundnessExp; eauto). by(eapply typingSoundnessExp; eauto).
match_pat (ssa _ _ _) (fun H => inversion H; subst; simpl in *). match_pat (ssa _ _ _) (fun H => inversion H; subst; simpl in *).
Flover_compute. Flover_compute.
edestruct (validIntervalbounds_sound e L1 (Gamma := Gamma)(P:= P) (A:=A) destruct H4 as [[valid_e valid_rec] valid_single].
(fVars:=fVars) (dVars:=dVars) pose proof (validRanges_single _ _ _ _ valid_e) as valid_e_single.
(E:=E1)) destruct valid_e_single
as [iv_e [err_e [vR_e [map_e [eval_e_real bounded_vR_e]]]]]; eauto. as [iv_e [err_e [vR_e [map_e [eval_e_real bounded_vR_e]]]]].
+ set_tac. split; try auto. destr_factorize.
split; try auto.
hnf; intros; subst; set_tac.
+ destr_factorize.
edestruct (validErrorbound_sound e (E1:=E1) (E2:=E2) (fVars:=fVars) edestruct (validErrorbound_sound e (E1:=E1) (E2:=E2) (fVars:=fVars)
(dVars := dVars) (A:=A) (P:=P) tMap (dVars := dVars) (A:=A) tMap
(nR:=v0) (err:=err_e) (elo:=q) (ehi:=q0)) (nR:=v0) (err:=err_e) (elo:=fst iv_e) (ehi:=snd iv_e))
as [[vF_e [m_e eval_float_e]] err_bounded_e]; eauto. as [[vF_e [m_e eval_float_e]] err_bounded_e]; eauto.
* set_tac. split; try auto. + set_tac. split; try auto.
split; try auto. split; try auto.
hnf; intros; subst; set_tac. hnf; intros; subst; set_tac.
* rewrite <- (meps_0_deterministic (toRExp e) eval_e_real H20) in *; try auto. + destruct iv_e; auto.
+ rewrite <- (meps_0_deterministic (toRExp e) eval_e_real H18) in *; try auto.
apply (IHf (updEnv n vR_e E1) (updEnv n v1 E2) apply (IHf (updEnv n vR_e E1) (updEnv n v1 E2)
(updDefVars n m Gamma) v vR m0 A tMap P fVars (updDefVars n m Gamma) v vR m0 A tMap fVars
(NatSet.add n dVars) (outVars)); eauto. (NatSet.add n dVars) (outVars)); eauto.
{ eapply approxUpdBound; eauto. * eapply approxUpdBound; eauto.
simpl in *. simpl in *.
apply Rle_trans with (r2:= Q2R err_e); try lra. apply Rle_trans with (r2:= Q2R err_e); try lra.
eapply err_bounded_e. eauto. eapply err_bounded_e. eauto.
apply Qle_Rle. apply Qle_Rle.
rewrite Qeq_bool_iff in *. rewrite Qeq_bool_iff in *.
destruct i; inversion Heqo0; subst. destruct i0; inversion Heqo0; subst.
rewrite R2. rewrite R2.
lra. } lra.
{ eapply ssa_equal_set; eauto. * eapply ssa_equal_set; eauto.
hnf. intros a; split; intros in_set. hnf. intros a; split; intros in_set.
- rewrite NatSet.add_spec, NatSet.union_spec; { rewrite NatSet.add_spec, NatSet.union_spec;
rewrite NatSet.union_spec, NatSet.add_spec in in_set. rewrite NatSet.union_spec, NatSet.add_spec in in_set.
destruct in_set as [P1 | [ P2 | P3]]; auto. destruct in_set as [P1 | [ P2 | P3]]; auto. }
- rewrite NatSet.add_spec, NatSet.union_spec in in_set; { rewrite NatSet.add_spec, NatSet.union_spec in in_set;
rewrite NatSet.union_spec, NatSet.add_spec. rewrite NatSet.union_spec, NatSet.add_spec.
destruct in_set as [P1 | [ P2 | P3]]; auto. } destruct in_set as [P1 | [ P2 | P3]]; auto. }
{ eapply (swap_Gamma_bstep (Gamma1 := updDefVars n REAL (toRMap Gamma))); eauto. * eapply (swap_Gamma_bstep (Gamma1 := updDefVars n REAL (toRMap Gamma))); eauto.
eauto using Rmap_updVars_comm. } eauto using Rmap_updVars_comm.
{ set_tac; split. * apply validRangesCmd_swap with (Gamma1:=updDefVars n REAL Gamma).
- split; try auto. { intros x; unfold toRMap, updDefVars.
destruct (x =? n) eqn:?; auto. }
{ eapply valid_rec. auto. }
* set_tac; split.
{ split; try auto.
hnf; intros; subst. hnf; intros; subst.
apply H5; rewrite NatSet.add_spec; auto.
- hnf; intros.
apply H5; rewrite NatSet.add_spec; auto. } apply H5; rewrite NatSet.add_spec; auto. }
{ intros v2 v2_fVar. { hnf; intros.
unfold updEnv. apply H5; rewrite NatSet.add_spec; auto. }
case_eq (v2 =? n); intros v2_eq. * unfold vars_typed. intros.
- apply Nat.eqb_eq in v2_eq; subst.
set_tac.
destruct v2_fVar as [? |[? ?]]; try congruence.
exists vR_e, (q1,q2), e1; split; try auto. split; try auto.
simpl; canonize_hyps. rewrite <- R4, <- R5. auto.
- apply H8; try auto.
set_tac. destruct v2_fVar as [v2_n | [? ?]]; try auto.
rewrite Nat.eqb_neq in v2_eq; congruence. }
{ unfold fVars_P_sound. intros. unfold updEnv.
destruct (v2 =? n) eqn:?; eauto.
rewrite Nat.eqb_eq in *; subst.
set_tac.
exfalso; apply H18; set_tac. }
{ unfold vars_typed. intros.
unfold updDefVars. unfold updDefVars.
destruct (v2 =? n) eqn:?; eauto. destruct (v2 =? n) eqn:?; eauto.
apply H10. rewrite NatSet.union_spec in *. apply H8. rewrite NatSet.union_spec in *.
destruct H4; try auto. destruct H4; try auto.
rewrite NatSet.add_spec in H4. rewrite NatSet.add_spec in H4.
rewrite Nat.eqb_neq in *. rewrite Nat.eqb_neq in *.
destruct H4; subst; try congruence; auto. } </