Commit e320513e authored by Heiko Becker's avatar Heiko Becker

Fix soundness proof for roundoff error valdator

parent c056a2d9
......@@ -18,22 +18,24 @@ exprression may yield different values for different machine epsilons
**)
Inductive approxEnv : env -> (expr R -> 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 ->
|approxRefl Gamma A:
approxEnv emptyEnv Gamma A NatSet.empty NatSet.empty emptyEnv
|approxUpdFree E1 E2 Gamma A v1 v2 x fVars dVars m:
approxEnv E1 Gamma A fVars dVars E2 ->
Gamma (Var R x) = Some m ->
(Rabs (v1 - v2) <= computeErrorR v1 m)%R ->
NatSet.mem x (NatSet.union fVars dVars) = false ->
approxEnv (updEnv x v1 E1)
(updDefVars (Var R x) m defVars) A (NatSet.add x fVars) dVars
(updDefVars (Var R x) m Gamma) 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 ->
|approxUpdBound E1 E2 Gamma A v1 v2 x fVars dVars m iv err:
approxEnv E1 Gamma A fVars dVars E2 ->
Gamma (Var R x) = Some m ->
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 (Var R x) m defVars) A fVars (NatSet.add x dVars)
Gamma A fVars (NatSet.add x dVars)
(updEnv x v2 E2).
Section RelationProperties.
......@@ -58,7 +60,7 @@ Section RelationProperties.
+ eapply IHa; eauto.
set_tac.
destruct x_valid; set_tac.
destruct H1 as [? | [? ?]]; subst; try auto.
destruct H2 as [? | [? ?]]; subst; try auto.
rewrite Nat.eqb_refl in eq_case; congruence.
- unfold updEnv in *.
case_eq (x =? x0); intros eq_case; rewrite eq_case in *.
......@@ -66,7 +68,7 @@ Section RelationProperties.
+ eapply IHa; auto.
set_tac.
destruct x_valid; set_tac.
destruct H2 as [? | [ ? ?]]; subst; try auto.
destruct H3 as [? | [ ? ?]]; subst; try auto.
rewrite Nat.eqb_refl in eq_case; congruence.
Qed.
......@@ -104,7 +106,7 @@ Section RelationProperties.
- assert (x =? x0 = false) as x_x0_neq.
{ rewrite Nat.eqb_neq; hnf; intros; subst.
set_tac.
apply H1.
apply H2.
set_tac. }
unfold updEnv in *; rewrite x_x0_neq in *.
unfold updDefVars in x_typed.
......@@ -130,7 +132,7 @@ Section RelationProperties.
- assert (x =? x0 = false) as x_x0_neq.
{ rewrite Nat.eqb_neq; hnf; intros; subst.
set_tac.
apply H0; set_tac.
apply H1; set_tac.
}
unfold updEnv in *; rewrite x_x0_neq in *.
unfold updDefVars in x_typed; cbn in x_typed.
......@@ -144,7 +146,7 @@ Section RelationProperties.
+ unfold updEnv in *;
rewrite Nat.eqb_refl in *; simpl in *.
inversion E1_def; inversion E2_def; subst.
rewrite A_e in *; inversion H; auto.
rewrite A_e in *; inversion H0; auto.
+ unfold updEnv in *; simpl in *.
rewrite <- Nat.eqb_neq in x_neq.
rewrite x_neq in *; simpl in *.
......
......@@ -362,7 +362,8 @@ Lemma round_abs_err_bounded (e:expr R) (nR nF1 nF:R) (E1 E2: env) (err:R)
eval_expr E1 (toRTMap defVars) (toREval e) nR REAL ->
eval_expr E2 defVars e nF1 m ->
eval_expr (updEnv 1 nF1 emptyEnv)
(updDefVars (Var R 1) m defVars)
(updDefVars (Downcast mEps (Var R 1)) mEps
(updDefVars (Var R 1) m defVars))
(toRExp (Downcast mEps (Var Q 1))) nF mEps->
(Rabs (nR - nF1) <= err)%R ->
(Rabs (nR - nF) <= err + computeErrorR nF1 mEps)%R.
......
This diff is collapsed.
......@@ -5,53 +5,54 @@ From Flover
Require Export Infra.ExpressionAbbrevs ErrorValidation RealRangeValidator
TypeValidator Environments.
Definition RoundoffErrorValidator (e:expr Q) (tMap:FloverMap.t mType) (A:analysisResult) (dVars:NatSet.t) :=
Definition RoundoffErrorValidator (e:expr Q) (tMap:FloverMap.t mType)
(A:analysisResult) (dVars:NatSet.t) :=
(* if *)
validErrorbound e tMap A dVars.
(*then true *)
(* else validAffineErrorBounds e A tMap dVars *)
Theorem RoundoffErrorValidator_sound:
forall (e : expr Q) (E1 E2 : env) (fVars dVars : NatSet.t) (A : analysisResult)
(nR : R) (err : error) (elo ehi : Q) (Gamma : FloverMap.t mType)
(defVars : nat -> option mType),
validTypes e Gamma ->
approxEnv E1 (toRExpMap Gamma) A fVars dVars E2 ->
NatSet.Subset (usedVars e -- dVars) fVars ->
eval_expr E1 (toRMap (toRExpMap Gamma)) (toREval (toRExp e)) nR REAL ->
RoundoffErrorValidator e Gamma A dVars = true ->
validRanges e A E1 (toRExpMap Gamma) ->
FloverMap.find (elt:=intv * error) e A = Some (elo, ehi, err) ->
(exists (nF : R) (m : mType),
eval_expr E2 (toRExpMap Gamma) (toRExp e) nF m) /\
(forall (nF : R) (m : mType),
eval_expr E2 (toRExpMap Gamma) (toRExp e) nF m ->
(Rabs (nR - nF) <= Q2R err)%R).
forall (e : expr Q) (E1 E2 : env) (fVars dVars : NatSet.t) (A : analysisResult)
(nR : R) (err : error) (elo ehi : Q) (Gamma : FloverMap.t mType),
validTypes e Gamma ->
approxEnv E1 (toRExpMap Gamma) A fVars dVars E2 ->
NatSet.Subset (usedVars e -- dVars) fVars ->
eval_expr E1 (toRTMap (toRExpMap Gamma)) (toREval (toRExp e)) nR REAL ->
RoundoffErrorValidator e Gamma A dVars = true ->
validRanges e A E1 (toRTMap (toRExpMap Gamma)) ->
FloverMap.find (elt:=intv * error) e A = Some (elo, ehi, err) ->
(exists (nF : R) (m : mType),
eval_expr E2 (toRExpMap Gamma) (toRExp e) nF m) /\
(forall (nF : R) (m : mType),
eval_expr E2 (toRExpMap Gamma) (toRExp e) nF m ->
(Rabs (nR - nF) <= Q2R err)%R).
Proof.
intros. cbn in *.
eapply validErrorbound_sound; eauto.
Qed.
Definition RoundoffErrorValidatorCmd (f:cmd Q) (tMap:FloverMap.t mType) (A:analysisResult) (dVars:NatSet.t) :=
Definition RoundoffErrorValidatorCmd (f:cmd Q) (tMap:FloverMap.t mType)
(A:analysisResult) (dVars:NatSet.t) :=
(* if *)
validErrorboundCmd f tMap A dVars.
(*then true *)
(* else validAffineErrorboundsCmd e A tMap dVars ... *)
Theorem RoundoffErrorValidatorCmd_sound f:
forall A E1 E2 outVars fVars dVars vR elo ehi err Gamma defVars,
(* TODO: Types *)
approxEnv E1 defVars A fVars dVars E2 ->
forall A E1 E2 outVars fVars dVars vR elo ehi err Gamma,
approxEnv E1 (toRExpMap Gamma) A fVars dVars E2 ->
ssa f (NatSet.union fVars dVars) outVars ->
NatSet.Subset (NatSet.diff (Commands.freeVars f) dVars) fVars ->
bstep (toREvalCmd (toRCmd f)) E1 (toRMap defVars) vR REAL ->
bstep (toREvalCmd (toRCmd f)) E1 (toRTMap (toRExpMap Gamma)) vR REAL ->
validErrorboundCmd f Gamma A dVars = true ->
validRangesCmd f A E1 defVars ->
validRangesCmd f A E1 (toRTMap (toRExpMap Gamma)) ->
validTypesCmd f Gamma ->
FloverMap.find (getRetExp f) A = Some ((elo,ehi),err) ->
(exists vF m,
bstep (toRCmd f) E2 defVars vF m) /\
bstep (toRCmd f) E2 (toRExpMap Gamma) vF m) /\
(forall vF mF,
bstep (toRCmd f) E2 defVars vF mF ->
bstep (toRCmd f) E2 (toRExpMap Gamma) vF mF ->
(Rabs (vR - vF) <= (Q2R err))%R).
Proof.
intros.
......
......@@ -29,7 +29,7 @@ Fixpoint validTypes e (Gamma:FloverMap.t mType) :Prop :=
| Var _ x => True
| Const m v => m = mG
| Unop u e1 =>
validTypes e1 Gamma /\ FloverMap.find e Gamma = Some mG
validTypes e1 Gamma /\ exists me, FloverMap.find e1 Gamma = Some me /\ isCompat me mG = true
| Binop b e1 e2 =>
validTypes e1 Gamma /\ validTypes e2 Gamma /\
exists m1 m2, FloverMap.find e1 Gamma = Some m1 /\ FloverMap.find e2 Gamma = Some m2 /\
......@@ -63,6 +63,20 @@ Proof.
destruct e; intros * [? [defined_m [check_t valid_top]]]; simpl in *; eauto.
Qed.
Corollary validTypes_exec e Gamma m:
validTypes e Gamma ->
FloverMap.find e Gamma = Some m ->
forall E v mR,
eval_expr E (toRExpMap Gamma) (toRExp e) v mR ->
m = mR.
Proof.
intros * valid_e find_e * eval_e.
apply validTypes_single in valid_e.
destruct valid_e as [? [find_e_new valid_exec]].
erewrite valid_exec; eauto.
congruence.
Qed.
Ltac validTypes_split :=
match goal with
| [ H: validTypes (Const ?m ?v) ?Gamma |- _] => idtac
......@@ -133,13 +147,16 @@ Fixpoint getValidMap (Gamma:FloverMap.t mType) (e:expr Q)
then Succes (FloverMap.add e m akk)
else Fail _ "Wrong type annotation for Constant"
| Unop u e1 =>
let akk_new := getTypeMap (getValidMap Gamma e1 akk) in
rlet akk_new := getValidMap Gamma e1 akk in
match FloverMap.find e1 akk_new with
| Some m_e1 =>
if (isFixedPointB m_e1)
then
match mOldO with
|Some mFix => addMono e mFix akk_new
|Some mFix =>
if (isCompat m_e1 mFix)
then addMono e mFix akk_new
else Fail _ "Incompatible type assignment"
|None => Fail _ "Undefined fixed-point type"
end
else
......@@ -370,16 +387,15 @@ Proof.
by_monotonicity find_akk Hmem.
+ inversion getMap_succeeds; subst.
by_monotonicity find_akk Hmem.
- destruct (getValidMap Gamma e akk) eqn:?; cbn in *; try congruence.
simpl in IHe. specialize (IHe Gamma akk t Heqr).
- specialize (IHe Gamma akk t Heqr).
destruct (isFixedPointB m0) eqn:?.
+ unfold_addMono; try eauto using IHe.
+ destruct (isCompat m0 m1) eqn:?; try congruence.
unfold_addMono; try eauto using IHe.
by_monotonicity find_akk Hmem.
+ destruct (mTypeEq m1 m0) eqn:?; try congruence.
unfold_addMono; try eauto using IHe.
by_monotonicity find_akk Hmem.
- destruct (isFixedPointB m0) eqn:?; try congruence.
destruct (getValidMap Gamma e akk) eqn:?; cbn in *; try congruence.
simpl in IHe. specialize (IHe Gamma akk t Heqr).
unfold_addMono; try eauto using IHe.
by_monotonicity find_akk Hmem.
......@@ -440,6 +456,8 @@ Proof.
pose proof (maps_mono _ _ find_map1) as find_mono; eexists; split; try eauto.
- repeat split; try eauto.
destruct check_top as [valid_e1 check_top]; eapply IHe; eauto.
destruct check_top as [? [? [? ?]]].
eexists; split; eauto.
- destruct check_top as [valid_e1 [valid_e2 validJoin]];
repeat split; try eauto.
destruct validJoin as [m1 [m2 [find_m1 [find_m2 join_true]]]].
......@@ -493,14 +511,16 @@ Proof.
apply Pos.compare_eq in Heqc; subst.
apply N.compare_eq in Heqc0; subst; congruence.
- destruct (unopEq u u0) eqn:?; [ | destruct (unopEq u Neg) eqn:?; congruence ].
destruct valid_e1 as [mG [find_mG [[valid_e1 _] valid_exec]]].
destruct valid_e1 as [mG [find_mG [[valid_e1 [? ?]] valid_exec]]].
specialize (IHe1 _ _ eq_exp valid_e1).
rewrite unopEq_compat_eq in Heqb; subst.
erewrite FloverMapFacts.P.F.find_o with (y:=Unop u0 e2) in find_mG; eauto.
exists mG; repeat split; try auto.
intros.
pose proof (expr_compare_eq_eval_compat (Unop u0 e1) (Unop u0 e2)).
simpl in *; rewrite <- H1 in H0; eauto.
+ destruct H. eexists; split; try eauto.
erewrite <- FloverMapFacts.P.F.find_o; eauto.
+ intros.
pose proof (expr_compare_eq_eval_compat (Unop u0 e1) (Unop u0 e2)).
simpl in *; rewrite <- H2 in H1; eauto.
- destruct valid_e1 as [mG [find_mG [[valid_esub1 [valid_esub2 join_valid]] valid_exec]]].
assert (b = b0) by (destruct b; destruct b0; cbn in *; congruence).
subst.
......@@ -624,14 +644,15 @@ Proof.
eapply validTypes_eq_compat; eauto.
eexists; split; [eauto using tMap_def | split; try auto].
intros * map_mono eval_const; inversion eval_const; subst; auto.
- destruct (FloverMap.find (elt:=mType) e (getTypeMap (getValidMap Gamma e akk))) eqn:?;
- destruct (getValidMap Gamma e akk) eqn:?; simpl in *; try congruence.
destruct (FloverMap.find (elt:=mType) e t) eqn:?; simpl in *;
try congruence.
intros * mem_add.
destruct (getValidMap Gamma e akk) eqn:?; cbn in Heqo; try congruence.
assert (forall e, FloverMap.mem e t = true -> validTypes e t) as valid_rec.
{ eapply IHe; eauto. }
destruct (isFixedPointB m) eqn:?.
+ Flover_compute.
destruct (isCompat m m0) eqn:?; try congruence.
unfold addMono in *; Flover_compute.
(* { destruct (mTypeEq m0 m1) eqn:?; try congruence. *)
(* inversion validMap_succ; subst. *)
......@@ -652,6 +673,8 @@ Proof.
* assert (FloverMap.mem e t = true)
by (rewrite FloverMapFacts.P.F.mem_find_b; rewrite Heqo; eauto).
eapply validTypes_mono with (map1:= t); eauto using map_find_mono.
* exists m; split; try auto.
eapply map_find_mono; try auto.
* intros * map_mono eval_unop.
assert (FloverMap.find (elt:=mType) (Unop u e) (FloverMap.add (Unop u e) m0 t) = Some m0)
as find_unop_t
......@@ -684,6 +707,9 @@ Proof.
* assert (FloverMap.mem e t = true)
by (rewrite FloverMapFacts.P.F.mem_find_b; rewrite Heqo; auto).
eapply (validTypes_mono _) with (map1:= t); eauto using map_find_mono.
* exists m; split.
{ eapply map_find_mono; auto. }
{ unfold isCompat; destruct m; auto using morePrecise_refl. }
* intros * map_mono eval_unop.
assert (FloverMap.find (elt:=mType) (Unop u e) (FloverMap.add (Unop u e) m t) = Some m)
by (eauto using tMap_def).
......@@ -1037,7 +1063,7 @@ Fixpoint validTypesCmd f (Gamma:FloverMap.t mType) :Prop :=
exists mG,
FloverMap.find e Gamma = Some mG /\
FloverMap.find (Var Q x) Gamma = Some m /\
morePrecise m mG = true /\
mTypeEq m mG = true /\
validTypes e Gamma /\
validTypesCmd g Gamma
| Ret e => validTypes e Gamma
......@@ -1068,7 +1094,7 @@ Fixpoint getValidMapCmd Gamma f akk :=
match FloverMap.find e res_e with
| None => Fail _ "No type computed for argument"
| Some m_e =>
if (morePrecise m m_e)
if (mTypeEq m m_e)
then
rlet newMap := addMono (Var Q x) m res_e in
getValidMapCmd Gamma g newMap
......@@ -1089,7 +1115,7 @@ Proof.
destruct (getValidMap Gamma e akk) eqn:?; simpl in getMap_succeeds;
try congruence.
destruct (FloverMap.find e t) eqn:?; try congruence.
destruct (morePrecise m m1) eqn:?; try congruence.
destruct (mTypeEq m m1) eqn:?; try congruence.
unfold addMono in *; Flover_compute.
specialize (IHf _ _ _ getMap_succeeds).
eapply IHf.
......@@ -1118,7 +1144,7 @@ Proof.
- destruct (getValidMap Gamma e akk) eqn:?; simpl in getMap_succeeds;
try congruence.
destruct (FloverMap.find e t) eqn:?; try congruence.
destruct (morePrecise m m0) eqn:?; try congruence.
destruct (mTypeEq m m0) eqn:?; try congruence.
pose proof (getValidMap_correct _ _ _ akk_sound Heqr) as t_sound.
unfold addMono in getMap_succeeds; Flover_compute.
assert (FloverMap.mem (Var Q n) t = false)
......
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