Skip to content

GitLab

Commit 43ce2820 authored by Raphaël Monat's avatar Raphaël Monat
Browse files
Options

Proofs done until validErrorbound_sound included

parent bd0ba831
Hide whitespace changes
Inline Side-by-side
Showing with 1270 additions and 366 deletions
coq/ErrorBounds.v
View file @ 43ce2820
......@@ -58,29 +58,28 @@ Lemma add_abs_err_bounded (e1:exp Q) (e1R:R) (e1F:R) (e2:exp Q) (e2R:R) (e2F:R)
Proof.
intros e1_real e1_float e2_real e2_float plus_real plus_float bound_e1 bound_e2.
(* Prove that e1R and e2R are the correct values and that vR is e1R + e2R *)
inversion plus_real; subst;
assert (m3 = M0) by (apply (ifM0isJoin_l M0 m3 m4); auto);
assert (m4 = M0) by (apply (ifM0isJoin_r M0 m3 m4); auto); subst;
simpl (meps M0) in H3; rewrite Q2R0_is_0 in H3; auto.
inversion plus_real; subst.
destruct m0; destruct m3; inversion H2;
simpl in H4; rewrite Q2R0_is_0 in H4; auto.
rewrite delta_0_deterministic in plus_real; auto.
rewrite (delta_0_deterministic (evalBinop Plus v1 v2) delta); auto.
unfold evalBinop in *; simpl in *.
clear delta H3.
rewrite (meps_0_deterministic (toRExp e1) H6 e1_real);
rewrite (meps_0_deterministic (toRExp e2) H7 e2_real).
rewrite (meps_0_deterministic (toRExp e1) H6 e1_real) in plus_real.
rewrite (meps_0_deterministic (toRExp e2) H7 e2_real) in plus_real.
clear H6 H7 v1 v2.
clear delta H4.
rewrite (meps_0_deterministic (toRExp e1) H5 e1_real);
rewrite (meps_0_deterministic (toRExp e2) H6 e2_real).
rewrite (meps_0_deterministic (toRExp e1) H5 e1_real) in plus_real.
rewrite (meps_0_deterministic (toRExp e2) H6 e2_real) in plus_real.
clear H5 H6 v1 v2.
(* Now unfold the float valued evaluation to get the deltas we need for the inequality *)
inversion plus_float; subst.
unfold perturb; simpl.
inversion H7; subst; inversion H8; subst.
inversion H6; subst; inversion H7; subst.
unfold updEnv; simpl.
unfold updEnv in H6,H9; simpl in *.
symmetry in H6,H9.
inversion H6; inversion H9; subst.
unfold updEnv in H5,H8; simpl in *.
symmetry in H5,H8.
inversion H5; inversion H8; subst.
(* We have now obtained all necessary values from the evaluations --> remove them for readability *)
clear plus_float H7 H8 plus_real e1_real e1_float e2_real e2_float H9 H6.
clear plus_float H7 H8 plus_real e1_real e1_float e2_real e2_float H5 H8.
repeat rewrite Rmult_plus_distr_l.
rewrite Rmult_1_r.
rewrite Rsub_eq_Ropp_Rplus.
......@@ -103,7 +102,7 @@ Proof.
eapply Rle_trans.
eapply Rmult_le_compat_l.
apply Rabs_pos.
apply H4.
apply H3.
apply Req_le; auto.
Qed.
......@@ -125,28 +124,27 @@ Proof.
intros e1_real e1_float e2_real e2_float sub_real sub_float bound_e1 bound_e2.
(* Prove that e1R and e2R are the correct values and that vR is e1R + e2R *)
inversion sub_real; subst;
assert (m3 = M0) by (apply (ifM0isJoin_l M0 m3 m4); auto);
assert (m4 = M0) by (apply (ifM0isJoin_r M0 m3 m4); auto); subst;
simpl (meps M0) in H3; rewrite Q2R0_is_0 in H3; auto.
destruct m0; destruct m3; inversion H2;
simpl in H4; rewrite Q2R0_is_0 in H4; auto.
rewrite delta_0_deterministic in sub_real; auto.
rewrite delta_0_deterministic; auto.
unfold evalBinop in *; simpl in *.
clear delta H3.
rewrite (meps_0_deterministic (toRExp e1) H6 e1_real);
rewrite (meps_0_deterministic (toRExp e2) H7 e2_real).
rewrite (meps_0_deterministic (toRExp e1) H6 e1_real) in sub_real.
rewrite (meps_0_deterministic (toRExp e2) H7 e2_real) in sub_real.
clear H6 H7 v1 v2.
clear delta H4.
rewrite (meps_0_deterministic (toRExp e1) H5 e1_real);
rewrite (meps_0_deterministic (toRExp e2) H6 e2_real).
rewrite (meps_0_deterministic (toRExp e1) H5 e1_real) in sub_real.
rewrite (meps_0_deterministic (toRExp e2) H6 e2_real) in sub_real.
clear H5 H6 v1 v2.
(* Now unfold the float valued evaluation to get the deltas we need for the inequality *)
inversion sub_float; subst.
unfold perturb; simpl.
inversion H7; subst; inversion H8; subst.
inversion H6; subst; inversion H7; subst.
unfold updEnv; simpl.
symmetry in H6, H9.
unfold updEnv in H6, H9; simpl in H6, H9.
inversion H6; inversion H9; subst.
symmetry in H5, H8.
unfold updEnv in H5, H8; simpl in H5, H8.
inversion H5; inversion H8; subst.
(* We have now obtained all necessary values from the evaluations --> remove them for readability *)
clear sub_float H7 H8 sub_real e1_real e1_float e2_real e2_float H6 H9.
clear sub_float H7 H8 sub_real e1_real e1_float e2_real e2_float H5 H8.
repeat rewrite Rmult_plus_distr_l.
rewrite Rmult_1_r.
repeat rewrite Rsub_eq_Ropp_Rplus.
......@@ -182,27 +180,26 @@ Proof.
intros e1_real e1_float e2_real e2_float mult_real mult_float.
(* Prove that e1R and e2R are the correct values and that vR is e1R * e2R *)
inversion mult_real; subst;
assert (m3 = M0) by (apply (ifM0isJoin_l M0 m3 m4); auto);
assert (m4 = M0) by (apply (ifM0isJoin_r M0 m3 m4); auto); subst;
simpl (meps M0) in H3; rewrite Q2R0_is_0 in H3; auto.
destruct m0; destruct m3; inversion H2;
simpl in H4; rewrite Q2R0_is_0 in H4; auto.
rewrite delta_0_deterministic in mult_real; auto.
rewrite delta_0_deterministic; auto.
unfold evalBinop in *; simpl in *.
clear delta H3.
rewrite (meps_0_deterministic (toRExp e1) H6 e1_real);
rewrite (meps_0_deterministic (toRExp e2) H7 e2_real).
rewrite (meps_0_deterministic (toRExp e1) H6 e1_real) in mult_real.
rewrite (meps_0_deterministic (toRExp e2) H7 e2_real) in mult_real.
clear H6 H7 v1 v2.
clear delta H4.
rewrite (meps_0_deterministic (toRExp e1) H5 e1_real);
rewrite (meps_0_deterministic (toRExp e2) H6 e2_real).
rewrite (meps_0_deterministic (toRExp e1) H5 e1_real) in mult_real.
rewrite (meps_0_deterministic (toRExp e2) H6 e2_real) in mult_real.
clear H5 H6 v1 v2.
(* Now unfold the float valued evaluation to get the deltas we need for the inequality *)
inversion mult_float; subst.
unfold perturb; simpl.
inversion H7; subst; inversion H8; subst.
symmetry in H6, H9;
inversion H6; subst; inversion H7; subst.
symmetry in H5, H8;
unfold updEnv in *; simpl in *.
inversion H6; inversion H9; subst.
inversion H5; inversion H8; subst.
(* We have now obtained all necessary values from the evaluations --> remove them for readability *)
clear mult_float H7 H8 mult_real e1_real e1_float e2_real e2_float H6 H9.
clear mult_float H7 H8 mult_real e1_real e1_float e2_real e2_float H5 H8.
repeat rewrite Rmult_plus_distr_l.
rewrite Rmult_1_r.
rewrite Rsub_eq_Ropp_Rplus.
......@@ -232,27 +229,26 @@ Proof.
intros e1_real e1_float e2_real e2_float div_real div_float.
(* Prove that e1R and e2R are the correct values and that vR is e1R * e2R *)
inversion div_real; subst;
assert (m3 = M0) by (apply (ifM0isJoin_l M0 m3 m4); auto);
assert (m4 = M0) by (apply (ifM0isJoin_r M0 m3 m4); auto); subst;
simpl (meps M0) in H3; rewrite Q2R0_is_0 in H3; auto.
destruct m0; destruct m3; inversion H2;
simpl in H4; rewrite Q2R0_is_0 in H4; auto.
rewrite delta_0_deterministic in div_real; auto.
rewrite delta_0_deterministic; auto.
unfold evalBinop in *; simpl in *.
clear delta H3.
rewrite (meps_0_deterministic (toRExp e1) H6 e1_real);
rewrite (meps_0_deterministic (toRExp e2) H7 e2_real).
rewrite (meps_0_deterministic (toRExp e1) H6 e1_real) in div_real.
rewrite (meps_0_deterministic (toRExp e2) H7 e2_real) in div_real.
clear H6 H7 v1 v2.
clear delta H4.
rewrite (meps_0_deterministic (toRExp e1) H5 e1_real);
rewrite (meps_0_deterministic (toRExp e2) H6 e2_real).
rewrite (meps_0_deterministic (toRExp e1) H5 e1_real) in div_real.
rewrite (meps_0_deterministic (toRExp e2) H6 e2_real) in div_real.
clear H5 H6 v1 v2.
(* Now unfold the float valued evaluation to get the deltas we need for the inequality *)
inversion div_float; subst.
unfold perturb; simpl.
inversion H7; subst; inversion H8; subst.
symmetry in H6, H9;
inversion H6; subst; inversion H7; subst.
symmetry in H5, H8;
unfold updEnv in *; simpl in *.
inversion H6; inversion H9; subst.
inversion H5; inversion H8; subst.
(* We have now obtained all necessary values from the evaluations --> remove them for readability *)
clear div_float H7 H8 div_real e1_real e1_float e2_real e2_float H6 H9.
clear div_float H7 H8 div_real e1_real e1_float e2_real e2_float H5 H8.
repeat rewrite Rmult_plus_distr_l.
rewrite Rmult_1_r.
rewrite Rsub_eq_Ropp_Rplus.
......@@ -447,10 +443,10 @@ Proof.
rewrite Q2R0_is_0; auto.
Qed.
Lemma round_abs_err_bounded (e:exp R) (nR nF1 nF:R) (E: env) (err:R) (machineEpsilon m:mType):
eval_exp E (toREval e) nR M0 ->
eval_exp E e nF1 m ->
eval_exp (updEnv 1 m nF1 E) (toRExp (Downcast machineEpsilon (Var Q m 1))) nF machineEpsilon->
Lemma round_abs_err_bounded (e:exp R) (nR nF1 nF:R) (E1 E2: env) (err:R) (machineEpsilon m:mType):
eval_exp E1 (toREval e) nR M0 ->
eval_exp E2 e nF1 m ->
eval_exp (updEnv 1 m nF1 emptyEnv) (toRExp (Downcast machineEpsilon (Var Q m 1))) nF machineEpsilon->
(Rabs (nR - nF1) <= err)%R ->
(Rabs (nR - nF) <= err + (Rabs nF1) * Q2R (meps machineEpsilon))%R.
Proof.
......
coq/ErrorValidation.v
View file @ 43ce2820
......@@ -68,13 +68,23 @@ Fixpoint validErrorbound (e:exp Q) (typeMap:exp Q -> option mType) (absenv:analy
Fixpoint validErrorboundCmd (f:cmd Q) (env:analysisResult) (dVars:NatSet.t) {struct f} : bool :=
match f with
|Let m x e g =>
let tmap := typeExpression e in
if ((validErrorbound e tmap env dVars) && (Qeq_bool (snd (env e)) (snd (env (Var Q m x)))))
if ((validErrorbound e (typeExpression e) env dVars) && (Qeq_bool (snd (env e)) (snd (env (Var Q m x)))))
then validErrorboundCmd g env (NatSet.add x dVars)
else false
|Ret e => validErrorbound e (typeExpression e) env dVars
end.
(* (** Error bound command validator **) *)
(* Fixpoint validErrorboundCmd (f:cmd Q) (typeMap:exp Q -> option mType) (env:analysisResult) (dVars:NatSet.t) {struct f} : bool := *)
(* match f with *)
(* |Let m x e g => *)
(* if ((validErrorbound e typeMap env dVars) && (Qeq_bool (snd (env e)) (snd (env (Var Q m x))))) *)
(* then validErrorboundCmd g typeMap env (NatSet.add x dVars) *)
(* else false *)
(* |Ret e => validErrorbound e typeMap env dVars *)
(* end. *)
(**
Since errors are intervals with 0 as center, we encode them as single values.
This lemma enables us to deduce from each run of the validator the invariant
......@@ -105,27 +115,30 @@ Proof.
+ destruct (tmap (Downcast m e));inversion validErrorbound_e.
Qed.
Lemma validErrorboundCorrectVariable:
forall E1 E2 absenv (v:nat) nR nF e nlo nhi P fVars dVars m over_var,
isSubExpression (Var Q m v) over_var = true ->
forall E1 E2 absenv (v:nat) nR nF e nlo nhi P fVars dVars m f,
approxEnv E1 absenv fVars dVars E2 ->
eval_exp E1 (toREval (toRExp (Var Q m v))) nR M0 ->
eval_exp E2 (toRExp (Var Q m v)) nF m ->
validIntervalbounds (Var Q m v) absenv P dVars = true ->
validErrorbound (Var Q m v) (typeExpression over_var) absenv dVars = true ->
(forall v m,
NatSet.mem v dVars = true ->
(typeExpression over_var) (Var Q m v) = Some m ->
isSubExpression (Var Q m v) f = true ->
validErrorbound (Var Q m v) (typeExpression f) absenv dVars = true ->
(forall v1 m1 overVar,
NatSet.mem v1 dVars = true ->
isSubExpression (Var Q m1 v1) overVar = true ->
(typeExpression overVar) (Var Q m1 v1) = Some m1 ->
exists r : R,
E1 v = Some (r, M0) /\
(Q2R (fst (fst (absenv (Var Q m v)))) <= r <= Q2R (snd (fst (absenv (Var Q m v)))))%R) ->
(forall v, NatSet.mem v fVars= true ->
exists r, E1 v = Some (r, M0) /\
(Q2R (fst (P v)) <= r <= Q2R (snd (P v)))%R) ->
E1 v1 = Some (r, M0) /\
(Q2R (fst (fst (absenv (Var Q m1 v1)))) <= r <= Q2R (snd (fst (absenv (Var Q m1 v1)))))%R) ->
(forall v1, NatSet.mem v1 fVars= true ->
exists r, E1 v1 = Some (r, M0) /\
(Q2R (fst (P v1)) <= r <= Q2R (snd (P v1)))%R) ->
absenv (Var Q m v) = ((nlo, nhi), e) ->
(Rabs (nR - nF) <= (Q2R e))%R.
Proof.
intros * isSubExpr approxCEnv eval_real eval_float bounds_valid error_valid dVars_sound P_valid absenv_var.
intros * approxCEnv eval_real eval_float bounds_valid subexpr_ok error_valid dVars_sound P_valid absenv_var.
simpl in eval_real; inversion eval_real; inversion eval_float; subst.
rename H2 into E1_v;
rename H7 into E2_v.
......@@ -137,9 +150,14 @@ Proof.
(* assert (v =? v = true) by (apply beq_nat_true_iff; auto). *)
(* congruence. *)
simpl in error_valid.
rewrite absenv_var in error_valid; simpl in error_valid.
case_eq (typeExpression over_var (Var Q m v)); intros; rewrite H in error_valid; [ | inversion error_valid ].
pose proof (typingVarDet _ _ _ H); subst; rename m0 into m.
rewrite absenv_var in error_valid; simpl in error_valid; subst.
case_eq (typeExpression f (Var Q m v)); intros; rewrite H in error_valid; [ | inversion error_valid].
(* assert (mTypeEqBool m m && (v =? v) = true). *)
(* apply andb_true_iff; split; [ rewrite EquivEqBoolEq | apply beq_nat_true_iff ]; auto. *)
(* rewrite H in error_valid. *)
rewrite <- andb_lazy_alt in error_valid.
andb_to_prop error_valid.
rename L into error_pos.
rename R into error_valid.
......@@ -167,6 +185,7 @@ Proof.
apply Qle_Rle in error_valid.
eapply Rle_trans; eauto.
rewrite Q2R_mult.
pose proof (typingVarDet _ _ _ H). symmetry in H2; subst.
apply Rmult_le_compat_r.
{ apply inj_eps_posR. }
{ rewrite <- maxAbs_impl_RmaxAbs.
......@@ -180,9 +199,13 @@ Proof.
apply valid_bounds_prf; try auto.
- intros v m0 v_mem_diff typing.
case_eq (mTypeEqBool m m0 && (x =? v)); intros; auto; rewrite H4 in typing; inversion typing; subst.
specialize (dVars_sound v m0 v_mem_diff).
apply andb_true_iff in H4; destruct H4 as [H4m H4x]; rewrite Nat.eqb_eq in H4x; subst.
specialize (dVars_sound v m0 (Var Q m0 v) v_mem_diff).
assert (mTypeEqBool m0 m0 && (v =? v) = true) by (apply andb_true_iff; split; [ apply mTypeEqBool_refl | rewrite <- beq_nat_refl ]; auto).
specialize (dVars_sound H).
assert (isSubExpression (Var Q m0 v) (Var Q m0 v) = true) by (simpl; rewrite H4; auto).
specialize (dVars_sound H5).
simpl typeExpression in dVars_sound.
rewrite H4 in dVars_sound.
specialize (dVars_sound typing).
apply dVars_sound.
- intros v v_mem_diff.
......@@ -193,8 +216,8 @@ Proof.
+ apply IHapproxCEnv; try auto.
* constructor; auto.
* constructor; auto.
* intros v0 m1 mem_dVars typing;
specialize (dVars_sound v0 m1 mem_dVars typing).
* intros v0 m2 overVar mem_dVars isSubExpr typing.
specialize (dVars_sound v0 m2 overVar mem_dVars isSubExpr typing).
destruct dVars_sound as [vR0 [val_def iv_sound_val]].
case_eq (v0 =? x); intros case_mem;
rewrite case_mem in val_def; simpl in val_def.
......@@ -250,14 +273,16 @@ Proof.
+ rewrite <- NatSet.mem_spec in v_dVar. rewrite v_dVar in case_dVars.
inversion case_dVars. }
{ rewrite not_in_add in error_valid; auto. }
* intros v0 m1 mem_dVars typing.
* intros v0 m2 overVar mem_dVars isSubExpr typing.
specialize (dVars_sound v0 m2 overVar).
rewrite absenv_var in *; simpl in *.
rewrite NatSet.mem_spec in mem_dVars.
assert (NatSet.In v0 (NatSet.add x dVars)) as v0_in_add.
{ rewrite NatSet.add_spec. right; auto. }
{ rewrite <- NatSet.mem_spec in v0_in_add.
specialize (dVars_sound v0 m1 v0_in_add typing).
specialize (dVars_sound v0_in_add isSubExpr typing).
destruct dVars_sound as [vR0 [val_def iv_sound_val]].
exists vR0; split; auto.
unfold updEnv in val_def; simpl in val_def.
case_eq (v0 =? x); intros case_mem;
rewrite case_mem in val_def; simpl in val_def.
......@@ -265,7 +290,7 @@ Proof.
apply (NatSetProps.Dec.F.union_3 fVars) in mem_dVars.
rewrite <- NatSet.mem_spec in mem_dVars.
rewrite mem_dVars in *; congruence.
- exists vR0; split; auto. }
- auto. }
* rewrite absenv_var in bounds_valid.
intros v0 v0_fVar.
specialize (P_valid v0 v0_fVar).
......@@ -279,23 +304,202 @@ Proof.
Qed.
(* Lemma validErrorboundCorrectVariable: *)
(* forall E1 E2 absenv (v:nat) nR nF e nlo nhi P fVars dVars m, *)
(* approxEnv E1 absenv fVars dVars E2 -> *)
(* eval_exp E1 (toREval (toRExp (Var Q m v))) nR M0 -> *)
(* eval_exp E2 (toRExp (Var Q m v)) nF m -> *)
(* validIntervalbounds (Var Q m v) absenv P dVars = true -> *)
(* validErrorbound (Var Q m v) (typeExpression (Var Q m v)) absenv dVars = true -> *)
(* (forall v1 m1, *)
(* NatSet.mem v1 dVars = true -> *)
(* (typeExpression (Var Q m1 v1)) (Var Q m1 v1) = Some m1 -> *)
(* exists r : R, *)
(* E1 v1 = Some (r, M0) /\ *)
(* (Q2R (fst (fst (absenv (Var Q m1 v1)))) <= r <= Q2R (snd (fst (absenv (Var Q m1 v1)))))%R) -> *)
(* (forall v1, NatSet.mem v1 fVars= true -> *)
(* exists r, E1 v1 = Some (r, M0) /\ *)
(* (Q2R (fst (P v1)) <= r <= Q2R (snd (P v1)))%R) -> *)
(* absenv (Var Q m v) = ((nlo, nhi), e) -> *)
(* (Rabs (nR - nF) <= (Q2R e))%R. *)
(* Proof. *)
(* intros * approxCEnv eval_real eval_float bounds_valid error_valid dVars_sound P_valid absenv_var. *)
(* simpl in eval_real; inversion eval_real; inversion eval_float; subst. *)
(* rename H2 into E1_v; *)
(* rename H7 into E2_v. *)
(* (* assert ((typeExpression (Var Q m v)) (Var Q m v) = Some m) as tEv. *) *)
(* (* unfold typeExpression. unfold expEqBool. *) *)
(* (* case_eq (mTypeEqBool m m && (v =? v)); intros; auto. *) *)
(* (* apply andb_false_iff in H. destruct H. assert (mTypeEqBool m m = true) by (apply EquivEqBoolEq; auto). *) *)
(* (* congruence. *) *)
(* (* assert (v =? v = true) by (apply beq_nat_true_iff; auto). *) *)
(* (* congruence. *) *)
(* simpl in error_valid. *)
(* rewrite absenv_var in error_valid; simpl in error_valid. *)
(* assert (mTypeEqBool m m && (v =? v) = true). *)
(* apply andb_true_iff; split; [ rewrite EquivEqBoolEq | apply beq_nat_true_iff ]; auto. *)
(* rewrite H in error_valid. *)
(* rewrite <- andb_lazy_alt in error_valid. *)
(* andb_to_prop error_valid. *)
(* rename L into error_pos. *)
(* rename R into error_valid. *)
(* (* induction on the approximation relation to do a case distinction on whether *)
(* we argue currently about a free or a let bound variable *) *)
(* induction approxCEnv. *)
(* (* empty environment case, contradiction *) *)
(* - unfold emptyEnv in *; simpl in *. *)
(* congruence. *)
(* - unfold updEnv in *; simpl in *. *)
(* case_eq (v =? x); intros eq_case; rewrite eq_case in *. *)
(* + rewrite Nat.eqb_eq in eq_case; subst. *)
(* assert (NatSet.mem x dVars = false) as x_not_bound. *)
(* * case_eq (NatSet.mem x dVars); intros case_mem; try auto. *)
(* rewrite NatSet.mem_spec in case_mem. *)
(* assert (NatSet.In x (NatSet.union fVars dVars)) *)
(* as x_in_union by (rewrite NatSet.union_spec; auto). *)
(* rewrite <- NatSet.mem_spec in x_in_union. *)
(* rewrite x_in_union in *. *)
(* congruence. *)
(* * rewrite x_not_bound in error_valid. *)
(* inversion E1_v; inversion E2_v; subst. *)
(* eapply Rle_trans; try eauto. *)
(* apply Qle_bool_iff in error_valid. *)
(* apply Qle_Rle in error_valid. *)
(* eapply Rle_trans; eauto. *)
(* rewrite Q2R_mult. *)
(* apply Rmult_le_compat_r. *)
(* { apply inj_eps_posR. } *)
(* { rewrite <- maxAbs_impl_RmaxAbs. *)
(* apply contained_leq_maxAbs. *)
(* unfold contained; simpl. *)
(* assert ((toRExp (Var Q m x)) = Var R m x) by (simpl; auto). *)
(* rewrite <- H2 in eval_float. *)
(* pose proof (typeExpressionIsSound _ eval_float). *)
(* pose proof (validIntervalbounds_sound (Var Q m x) A P (E:=fun y : nat => if y =? x then Some (nR, M0) else E1 y) (vR:=nR) H3 bounds_valid (fVars := (NatSet.add x fVars))) as valid_bounds_prf. *)
(* rewrite absenv_var in valid_bounds_prf; simpl in valid_bounds_prf. *)
(* apply valid_bounds_prf; try auto. *)
(* - intros v m0 v_mem_diff typing. *)
(* case_eq (mTypeEqBool m m0 && (x =? v)); intros; auto; rewrite H4 in typing; inversion typing; subst. *)
(* apply andb_true_iff in H4; destruct H4 as [H4m H4x]; rewrite Nat.eqb_eq in H4x; subst. *)
(* specialize (dVars_sound v m0 v_mem_diff). *)
(* assert (mTypeEqBool m0 m0 && (v =? v) = true) by (apply andb_true_iff; split; [ apply mTypeEqBool_refl | rewrite <- beq_nat_refl ]; auto). *)
(* rewrite H4 in dVars_sound. *)
(* specialize (dVars_sound typing). *)
(* apply dVars_sound. *)
(* - intros v v_mem_diff. *)
(* rewrite NatSet.diff_spec, NatSet.singleton_spec in v_mem_diff. *)
(* destruct v_mem_diff as [v_eq v_no_dVar]. *)
(* subst. *)
(* rewrite NatSet.add_spec; auto. } *)
(* + apply IHapproxCEnv; try auto. *)
(* * constructor; auto. *)
(* * constructor; auto. *)
(* * intros v0 m1 mem_dVars typing. *)
(* specialize (dVars_sound v0 m1 mem_dVars typing). *)
(* destruct dVars_sound as [vR0 [val_def iv_sound_val]]. *)
(* case_eq (v0 =? x); intros case_mem; *)
(* rewrite case_mem in val_def; simpl in val_def. *)
(* { rewrite Nat.eqb_eq in case_mem; subst. *)
(* rewrite NatSet.mem_spec in mem_dVars. *)
(* assert (NatSet.In x (NatSet.union fVars dVars)) *)
(* as x_in_union by (rewrite NatSet.union_spec; auto). *)
(* rewrite <- NatSet.mem_spec in x_in_union; *)
(* rewrite x_in_union in *; congruence. } *)
(* { exists vR0; split; auto. } *)
(* * intros v0 v0_fVar. *)
(* assert (NatSet.mem v0 (NatSet.add x fVars) = true) *)
(* as v0_in_add by (rewrite NatSet.mem_spec, NatSet.add_spec; rewrite NatSet.mem_spec in v0_fVar; auto). *)
(* specialize (P_valid v0 v0_in_add). *)
(* case_eq (v0 =? x); intros case_v0; rewrite case_v0 in *; try auto. *)
(* rewrite Nat.eqb_eq in case_v0; subst. *)
(* assert (NatSet.mem x (NatSet.union fVars dVars) = true) *)
(* as x_in_union *)
(* by (rewrite NatSet.mem_spec, NatSet.union_spec; rewrite NatSet.mem_spec in v0_fVar; auto). *)
(* rewrite x_in_union in *; congruence. *)
(* - unfold updEnv in E1_v, E2_v; simpl in *. *)
(* case_eq (v =? x); intros eq_case; rewrite eq_case in *. *)
(* + rewrite Nat.eqb_eq in eq_case; subst. *)
(* inversion E1_v; inversion E2_v; subst. *)
(* rewrite absenv_var in *; auto. *)
(* + apply IHapproxCEnv; try auto. *)
(* * constructor; auto. *)
(* * constructor; auto. *)
(* * rewrite absenv_var. *)
(* case_eq (NatSet.mem v dVars); *)
(* intros case_dVars; rewrite case_dVars in *; simpl in *; try auto. *)
(* assert (NatSet.mem v (NatSet.add x dVars) = false) as not_in_add. *)
(* { case_eq (NatSet.mem v (NatSet.add x dVars)); *)
(* intros case_add; rewrite case_add in *; simpl in *; try auto. *)
(* - rewrite NatSet.mem_spec in case_add. *)
(* rewrite NatSet.add_spec in case_add. *)
(* destruct case_add as [v_eq_x | v_dVar]; subst. *)
(* + rewrite Nat.eqb_neq in eq_case. exfalso; apply eq_case; auto. *)
(* + rewrite <- NatSet.mem_spec in v_dVar. rewrite v_dVar in case_dVars. *)
(* inversion case_dVars. } *)
(* { rewrite absenv_var in bounds_valid. rewrite not_in_add in bounds_valid. *)
(* auto. } *)
(* * rewrite absenv_var in bounds_valid; simpl in *. *)
(* case_eq (NatSet.mem v dVars); *)
(* intros case_dVars; rewrite case_dVars in *; simpl in *; try auto. *)
(* assert (NatSet.mem v (NatSet.add x dVars) = false) as not_in_add. *)
(* { case_eq (NatSet.mem v (NatSet.add x dVars)); *)
(* intros case_add; rewrite case_add in *; simpl in *; try auto. *)
(* - rewrite NatSet.mem_spec in case_add. *)
(* rewrite NatSet.add_spec in case_add. *)
(* destruct case_add as [v_eq_x | v_dVar]; subst. *)
(* + rewrite Nat.eqb_neq in eq_case. exfalso; apply eq_case; auto. *)
(* + rewrite <- NatSet.mem_spec in v_dVar. rewrite v_dVar in case_dVars. *)
(* inversion case_dVars. } *)
(* { rewrite not_in_add in error_valid; auto. } *)
(* * intros v0 m1 mem_dVars typing. *)
(* specialize (dVars_sound v0 m1). *)
(* rewrite absenv_var in *; simpl in *. *)
(* rewrite NatSet.mem_spec in mem_dVars. *)
(* assert (NatSet.In v0 (NatSet.add x dVars)) as v0_in_add. *)
(* { rewrite NatSet.add_spec. right; auto. } *)
(* { rewrite <- NatSet.mem_spec in v0_in_add. *)
(* specialize (dVars_sound v0_in_add typing). *)
(* destruct dVars_sound as [vR0 [val_def iv_sound_val]]. *)
(* exists vR0; split; auto. *)
(* unfold updEnv in val_def; simpl in val_def. *)
(* case_eq (v0 =? x); intros case_mem; *)
(* rewrite case_mem in val_def; simpl in val_def. *)
(* - rewrite Nat.eqb_eq in case_mem; subst. *)
(* apply (NatSetProps.Dec.F.union_3 fVars) in mem_dVars. *)
(* rewrite <- NatSet.mem_spec in mem_dVars. *)
(* rewrite mem_dVars in *; congruence. *)
(* - auto. } *)
(* * rewrite absenv_var in bounds_valid. *)
(* intros v0 v0_fVar. *)
(* specialize (P_valid v0 v0_fVar). *)
(* unfold updEnv in P_valid; simpl in *. *)
(* case_eq (v0 =? x); intros case_v0; rewrite case_v0 in *; try auto. *)
(* rewrite Nat.eqb_eq in case_v0; subst. *)
(* assert (NatSet.mem x (NatSet.union fVars dVars) = true) *)
(* as x_in_union *)
(* by (rewrite NatSet.mem_spec, NatSet.union_spec; rewrite NatSet.mem_spec in v0_fVar; auto). *)
(* rewrite x_in_union in *; congruence. *)
(* Qed. *)
Lemma validErrorboundCorrectConstant:
forall E1 E2 absenv (n:Q) nR nF e nlo nhi dVars m,
forall E1 E2 absenv (n:Q) nR nF e nlo nhi dVars m f,
eval_exp E1 (toREval (toRExp (Const m n))) nR M0 ->
eval_exp E2 (toRExp (Const m n)) nF m ->
validErrorbound (Const m n) (typeExpression (Const m n)) absenv dVars = true ->
isSubExpression (Const m n) f = true ->
validErrorbound (Const m n) (typeExpression f) absenv dVars = true ->
(Q2R nlo <= nR <= Q2R nhi)%R ->
absenv (Const m n) = ((nlo,nhi),e) ->
(Rabs (nR - nF) <= (Q2R e))%R.
Proof.
intros * eval_real eval_float error_valid intv_valid absenv_const.
intros * eval_real eval_float subexpr_ok error_valid intv_valid absenv_const.
eapply Rle_trans.
simpl in eval_real,eval_float.
eapply const_abs_err_bounded; eauto.
unfold validErrorbound in error_valid.
rewrite absenv_const in *; simpl in *.
assert (mTypeEqBool m m && Qeq_bool n n = true) by (apply andb_true_iff; split; [ apply mTypeEqBool_refl | apply Qeq_bool_iff; apply Qeq_refl ]).
rewrite H in error_valid.
case_eq (typeExpression f (Const m n)); intros; rewrite H in error_valid; [ | inversion error_valid ].
andb_to_prop error_valid.
rename R into error_valid.
inversion eval_real; subst.
......@@ -310,6 +514,7 @@ Proof.
apply RmaxAbs; eauto.
- rewrite Q2R_mult in error_valid.
rewrite <- maxAbs_impl_RmaxAbs in error_valid; auto.
pose proof (typingConstDet _ _ _ H); subst; auto.
Qed.
(*
......@@ -375,7 +580,7 @@ Qed.*)
Lemma validErrorboundCorrectAddition E1 E2 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) dVars m m1 m2:
(alo ahi e1lo e1hi e2lo e2hi:Q) dVars m m1 m2 f:
m = computeJoin m1 m2 ->
eval_exp E1 (toREval (toRExp e1)) nR1 M0 ->
eval_exp E1 (toREval (toRExp e2)) nR2 M0 ->
......@@ -383,7 +588,8 @@ Lemma validErrorboundCorrectAddition E1 E2 absenv
eval_exp E2 (toRExp e1) nF1 m1 ->
eval_exp E2 (toRExp e2) nF2 m2 ->
eval_exp (updEnv 2 m2 nF2 (updEnv 1 m1 nF1 emptyEnv)) (toRExp