Commit bac7151e authored by Joachim Bard's avatar Joachim Bard

Merge remote-tracking branch 'upstream/master'

merge with Nikita's changes
parents 923d82d0 cad900bc
......@@ -30,8 +30,8 @@ Definition CertificateChecker (e:expr Q) (absenv:analysisResult)
**)
Theorem Certificate_checking_is_sound (e:expr Q) (absenv:analysisResult) P Qmap defVars:
forall (E1 E2:env) DeltaMap,
(forall (e' : expr R) (m' : mType),
exists d : R, DeltaMap e' m' = Some d /\ (Rabs d <= mTypeToR m')%R) ->
(forall (v : R) (m' : mType),
exists d : R, DeltaMap v m' = Some d /\ (Rabs d <= mTypeToR m')%R) ->
eval_precond E1 P ->
unsat_queries Qmap ->
CertificateChecker e absenv P Qmap defVars = true ->
......@@ -79,11 +79,11 @@ Proof.
destruct iv_e as [elo ehi].
exists Gamma; intros approxE1E2.
assert (dVars_contained NatSet.empty (FloverMap.empty (affine_form Q))) as Hdvars
by (unfold dVars_contained; intros * Hset; clear - Hset; set_tac).
pose proof (RoundoffErrorValidator_sound e _ deltas_matched H approxE1E2 H1 eval_real R
valid_e map_e Hdvars) as Hsound.
by (unfold dVars_contained; intros * Hset; clear - Hset; set_tac).
pose proof (RoundoffErrorValidator_sound e H approxE1E2 H1 eval_real R
valid_e map_e Hdvars) as Hsound.
unfold validErrorBounds in Hsound.
eapply validErrorBounds_single in Hsound; eauto.
eapply validErrorBoundsRec_single in Hsound; eauto.
destruct Hsound as [[vF [mF eval_float]] err_bounded]; auto.
exists (elo, ehi), err_e, vR, vF, mF; repeat split; auto.
Qed.
......@@ -105,8 +105,8 @@ Definition CertificateCheckerCmd (f:cmd Q) (absenv:analysisResult) (P: precond)
Theorem Certificate_checking_cmds_is_sound (f:cmd Q) (absenv:analysisResult) P Qmap
defVars DeltaMap:
forall (E1 E2:env),
(forall (e' : expr R) (m' : mType),
exists d : R, DeltaMap e' m' = Some d /\ (Rabs d <= mTypeToR m')%R) ->
(forall (v : R) (m' : mType),
exists d : R, DeltaMap v m' = Some d /\ (Rabs d <= mTypeToR m')%R) ->
eval_precond E1 P ->
unsat_queries Qmap ->
CertificateCheckerCmd f absenv P Qmap defVars = true ->
......@@ -160,7 +160,7 @@ Proof.
destruct iv as [f_lo f_hi].
pose proof RoundoffErrorValidatorCmd_sound as Hsound.
eapply validErrorBoundsCmd_single in Hsound; eauto.
eapply validErrorBoundsCmdRec_single in Hsound; eauto.
- specialize Hsound as ((vF & mF & eval_float) & ?).
exists (f_lo, f_hi), err, vR, vF, mF; repeat split; try auto.
- eapply ssa_equal_set. 2: exact ssa_f_small.
......
......@@ -48,7 +48,7 @@ Inductive sstep : cmd R -> env -> R -> cmd R -> env -> Prop :=
Define big step semantics for the Flover language, terminating on a "returned"
result value
**)
Inductive bstep : cmd R -> env -> (expr R -> option mType) -> (expr R -> mType -> option R) ->
Inductive bstep : cmd R -> env -> (expr R -> option mType) -> (R -> mType -> option R) ->
R -> mType -> Prop :=
let_b m m' x e s E v res defVars DeltaMap:
eval_expr E defVars DeltaMap e v m ->
......
......@@ -4,17 +4,17 @@ From Coq
From Flover
Require Import Commands ExpressionSemantics Environments RealRangeArith TypeValidator.
Fixpoint validErrorBounds (e:expr Q) E1 E2 A Gamma DeltaMap :Prop :=
Fixpoint validErrorBoundsRec (e:expr Q) E1 E2 A Gamma DeltaMap :Prop :=
(match e with
| Unop u e => validErrorBounds e E1 E2 A Gamma DeltaMap
| Downcast m e => validErrorBounds e E1 E2 A Gamma DeltaMap
| Unop u e => validErrorBoundsRec e E1 E2 A Gamma DeltaMap
| Downcast m e => validErrorBoundsRec e E1 E2 A Gamma DeltaMap
| Binop b e1 e2 =>
validErrorBounds e1 E1 E2 A Gamma DeltaMap /\
validErrorBounds e2 E1 E2 A Gamma DeltaMap
validErrorBoundsRec e1 E1 E2 A Gamma DeltaMap /\
validErrorBoundsRec e2 E1 E2 A Gamma DeltaMap
| Fma e1 e2 e3 =>
validErrorBounds e1 E1 E2 A Gamma DeltaMap /\
validErrorBounds e2 E1 E2 A Gamma DeltaMap /\
validErrorBounds e3 E1 E2 A Gamma DeltaMap
validErrorBoundsRec e1 E1 E2 A Gamma DeltaMap /\
validErrorBoundsRec e2 E1 E2 A Gamma DeltaMap /\
validErrorBoundsRec e3 E1 E2 A Gamma DeltaMap
| _ => True
end) /\
forall v__R (iv: intv) (err: error),
......@@ -26,8 +26,14 @@ Fixpoint validErrorBounds (e:expr Q) E1 E2 A Gamma DeltaMap :Prop :=
eval_expr E2 (toRExpMap Gamma) DeltaMap (toRExp e) v__FP m__FP ->
(Rabs (v__R - v__FP) <= (Q2R err))%R).
Lemma validErrorBounds_single e E1 E2 A Gamma DeltaMap:
validErrorBounds e E1 E2 A Gamma DeltaMap ->
Definition validErrorBounds e E1 E2 A Gamma: Prop :=
forall DeltaMap,
(forall (v : R) (m' : mType),
exists d : R, DeltaMap v m' = Some d /\ (Rabs d <= mTypeToR m')%R) ->
validErrorBoundsRec e E1 E2 A Gamma DeltaMap.
Lemma validErrorBoundsRec_single e E1 E2 A Gamma DeltaMap:
validErrorBoundsRec e E1 E2 A Gamma DeltaMap ->
forall v__R iv err,
eval_expr E1 (toRTMap (toRExpMap Gamma)) DeltaMapR (toREval (toRExp e)) v__R REAL ->
FloverMap.find e A = Some (iv, err) ->
......@@ -39,13 +45,13 @@ Lemma validErrorBounds_single e E1 E2 A Gamma DeltaMap:
Proof.
intros validError_e;
intros; destruct e; cbn in *; split;
destruct validError_e as (? & ? & ?); eauto.
edestruct validError_e as (? & ? & ?); eauto.
Qed.
Fixpoint validErrorBoundsCmd (c: cmd Q) E1 E2 A Gamma DeltaMap: Prop :=
Fixpoint validErrorBoundsCmdRec (c: cmd Q) E1 E2 A Gamma DeltaMap: Prop :=
match c with
| Let m x e k =>
validErrorBounds e E1 E2 A Gamma DeltaMap /\
validErrorBoundsRec e E1 E2 A Gamma DeltaMap /\
(exists iv_e err_e iv_x err_x,
FloverMap.find e A = Some (iv_e, err_e) /\
FloverMap.find (Var Q x) A = Some (iv_x, err_x) /\
......@@ -53,8 +59,8 @@ Fixpoint validErrorBoundsCmd (c: cmd Q) E1 E2 A Gamma DeltaMap: Prop :=
(forall v__R v__FP,
eval_expr E1 (toRTMap (toRExpMap Gamma)) DeltaMapR (toREval (toRExp e)) v__R REAL ->
eval_expr E2 (toRExpMap Gamma) DeltaMap (toRExp e) v__FP m ->
validErrorBoundsCmd k (updEnv x v__R E1) (updEnv x v__FP E2) A Gamma DeltaMap)
| Ret e => validErrorBounds e E1 E2 A Gamma DeltaMap
validErrorBoundsCmdRec k (updEnv x v__R E1) (updEnv x v__FP E2) A Gamma DeltaMap)
| Ret e => validErrorBoundsRec e E1 E2 A Gamma DeltaMap
end /\
forall v__R (iv: intv) (err: error),
bstep (toREvalCmd (toRCmd c)) E1 (toRTMap (toRExpMap Gamma)) DeltaMapR v__R REAL ->
......@@ -65,8 +71,14 @@ Fixpoint validErrorBoundsCmd (c: cmd Q) E1 E2 A Gamma DeltaMap: Prop :=
bstep (toRCmd c) E2 (toRExpMap Gamma) DeltaMap v__FP m__FP ->
(Rabs (v__R - v__FP) <= (Q2R err))%R).
Lemma validErrorBoundsCmd_single c E1 E2 A Gamma DeltaMap:
validErrorBoundsCmd c E1 E2 A Gamma DeltaMap ->
Definition validErrorBoundsCmd (c: cmd Q) E1 E2 A Gamma: Prop :=
forall DeltaMap,
(forall (v : R) (m' : mType),
exists d : R, DeltaMap v m' = Some d /\ (Rabs d <= mTypeToR m')%R) ->
validErrorBoundsCmdRec c E1 E2 A Gamma DeltaMap.
Lemma validErrorBoundsCmdRec_single c E1 E2 A Gamma DeltaMap:
validErrorBoundsCmdRec c E1 E2 A Gamma DeltaMap ->
forall v__R (iv: intv) (err: error),
bstep (toREvalCmd (toRCmd c)) E1 (toRTMap (toRExpMap Gamma)) DeltaMapR v__R REAL ->
FloverMap.find (getRetExp c) A = Some (iv, err) ->
......@@ -78,5 +90,5 @@ Lemma validErrorBoundsCmd_single c E1 E2 A Gamma DeltaMap:
Proof.
intros validError_e;
intros; destruct c; cbn in *; split;
destruct validError_e as (? & ? & ?); eauto.
edestruct validError_e as (? & ? & ?); eauto.
Qed.
......@@ -43,8 +43,8 @@ Lemma add_abs_err_bounded (e1:expr Q) (e1R:R) (e1F:R) (e2:expr Q) (e2R:R) (e2F:R
eval_expr (updEnv 2 e2F (updEnv 1 e1F emptyEnv))
(updDefVars (Binop Plus (Var R 1) (Var R 2)) m
(updDefVars (Var R 2) m2 (updDefVars (Var R 1) m1 defVars)))
(fun x _ => if R_orderedExps.eq_dec x (Binop Plus (Var R 1) (Var R 2))
then DeltaMap (Binop Plus (toRExp e1) (toRExp e2)) m
(fun x _ => if Req_dec_sum x (evalBinop Plus e1F e2F)
then DeltaMap (evalBinop Plus e1F e2F) m
else None)
(Binop Plus (Var R 1) (Var R 2)) vF m ->
(Rabs (e1R - e1F) <= Q2R err1)%R ->
......@@ -116,8 +116,8 @@ Lemma subtract_abs_err_bounded (e1:expr Q) (e1R:R) (e1F:R) (e2:expr Q) (e2R:R)
eval_expr (updEnv 2 e2F (updEnv 1 e1F emptyEnv))
(updDefVars (Binop Sub (Var R 1) (Var R 2)) m
(updDefVars (Var R 2) m2 (updDefVars (Var R 1) m1 defVars)))
(fun x _ => if R_orderedExps.eq_dec x (Binop Sub (Var R 1) (Var R 2))
then DeltaMap (Binop Sub (toRExp e1) (toRExp e2)) m
(fun x _ => if Req_dec_sum x (evalBinop Sub e1F e2F)
then DeltaMap (evalBinop Sub e1F e2F) m
else None)
(Binop Sub (Var R 1) (Var R 2)) vF m ->
(Rabs (e1R - e1F) <= Q2R err1)%R ->
......@@ -194,8 +194,8 @@ Lemma mult_abs_err_bounded (e1:expr Q) (e1R:R) (e1F:R) (e2:expr Q) (e2R:R) (e2F:
eval_expr (updEnv 2 e2F (updEnv 1 e1F emptyEnv))
(updDefVars (Binop Mult (Var R 1) (Var R 2)) m
(updDefVars (Var R 2) m2 (updDefVars (Var R 1) m1 defVars)))
(fun x _ => if R_orderedExps.eq_dec x (Binop Mult (Var R 1) (Var R 2))
then DeltaMap (Binop Mult (toRExp e1) (toRExp e2)) m
(fun x _ => if Req_dec_sum x (evalBinop Mult e1F e2F)
then DeltaMap (evalBinop Mult e1F e2F) m
else None)
(Binop Mult (Var R 1) (Var R 2)) vF m ->
(Rabs (vR - vF) <= Rabs (e1R * e2R - e1F * e2F) + computeErrorR (e1F * e2F) m)%R.
......@@ -245,8 +245,8 @@ Lemma div_abs_err_bounded (e1:expr Q) (e1R:R) (e1F:R) (e2:expr Q) (e2R:R) (e2F:R
eval_expr (updEnv 2 e2F (updEnv 1 e1F emptyEnv))
(updDefVars (Binop Div (Var R 1) (Var R 2)) m
(updDefVars (Var R 2) m2 (updDefVars (Var R 1) m1 defVars)))
(fun x _ => if R_orderedExps.eq_dec x (Binop Div (Var R 1) (Var R 2))
then DeltaMap (Binop Div (toRExp e1) (toRExp e2)) m
(fun x _ => if Req_dec_sum x (evalBinop Div e1F e2F)
then DeltaMap (evalBinop Div e1F e2F) m
else None)
(Binop Div (Var R 1) (Var R 2)) vF m ->
(Rabs (vR - vF) <= Rabs (e1R / e2R - e1F / e2F) + computeErrorR (e1F / e2F) m)%R.
......@@ -301,8 +301,8 @@ Lemma fma_abs_err_bounded (e1:expr Q) (e1R:R) (e1F:R) (e2:expr Q) (e2R:R) (e2F:R
(updDefVars (Fma (Var R 1) (Var R 2) (Var R 3)) m
(updDefVars (Var R 3) m3
(updDefVars (Var R 2) m2 (updDefVars (Var R 1) m1 defVars))))
(fun x _ => if R_orderedExps.eq_dec x (Fma (Var R 1) (Var R 2) (Var R 3))
then DeltaMap (Fma (toRExp e1) (toRExp e2) (toRExp e3)) m
(fun x _ => if Req_dec_sum x (evalFma e1F e2F e3F)
then DeltaMap (evalFma e1F e2F e3F) m
else None)
(Fma (Var R 1) (Var R 2) (Var R 3)) vF m ->
(Rabs (vR - vF) <= Rabs ((e1R * e2R - e1F * e2F) + (e3R - e3F)) + computeErrorR (e1F * e2F + e3F ) m)%R.
......@@ -366,8 +366,8 @@ Lemma round_abs_err_bounded (e:expr R) (nR nF1 nF:R) (E1 E2: env) (err:R)
eval_expr (updEnv 1 nF1 emptyEnv)
(updDefVars (Downcast mEps (Var R 1)) mEps
(updDefVars (Var R 1) m defVars))
(fun x _ => if R_orderedExps.eq_dec x (Downcast mEps (Var R 1))
then DeltaMap (Downcast mEps e) mEps
(fun x _ => if Req_dec_sum x nF1
then DeltaMap nF1 mEps
else None)
(toRExp (Downcast mEps (Var Q 1))) nF mEps->
(Rabs (nR - nF1) <= err)%R ->
......
......@@ -236,8 +236,8 @@ Proof.
Qed.
Lemma validErrorboundCorrectConstant_eval E2 m n Gamma DeltaMap:
(forall (e' : expr R) (m' : mType),
exists d : R, DeltaMap e' m' = Some d /\ (Rabs d <= mTypeToR m')%R) ->
(forall (v : R) (m' : mType),
exists d : R, DeltaMap v m' = Some d /\ (Rabs d <= mTypeToR m')%R) ->
validTypes (Const m n) Gamma ->
exists nF m',
eval_Fin E2 Gamma DeltaMap (Const m n) nF m'.
......@@ -245,7 +245,7 @@ Proof.
intros deltas_matched typing_ok.
simpl in typing_ok.
destruct typing_ok as [? [type_def [? ?]]]; subst.
specialize (deltas_matched (Const x (Q2R n)) x) as (delta & delta_matched & delta_bound).
specialize (deltas_matched (Q2R n) x) as (delta & delta_matched & delta_bound).
repeat eexists.
eapply Const_dist' with (delta := delta); eauto.
Qed.
......@@ -287,8 +287,8 @@ Lemma validErrorboundCorrectAddition E1 E2 A
(updDefVars (Binop Plus (Var R 1) (Var R 2)) m
(updDefVars (Var Rdefinitions.R 2) m2
(updDefVars (Var Rdefinitions.R 1) m1 (toRExpMap Gamma))))
(fun x _ => if R_orderedExps.eq_dec x (Binop Plus (Var R 1) (Var R 2))
then DeltaMap (Binop Plus (toRExp e1) (toRExp e2)) m
(fun x _ => if Req_dec_sum x (evalBinop Plus nF1 nF2)
then DeltaMap (evalBinop Plus nF1 nF2) m
else None)
(toRExp (Binop Plus (Var Q 1) (Var Q 2))) nF m ->
validErrorbound (Binop Plus e1 e2) Gamma A dVars = true ->
......@@ -349,8 +349,8 @@ Lemma validErrorboundCorrectSubtraction E1 E2 A
(updDefVars (Binop Sub (Var R 1) (Var R 2)) m
(updDefVars (Var Rdefinitions.R 2) m2
(updDefVars (Var Rdefinitions.R 1) m1 (toRExpMap Gamma))))
(fun x _ => if R_orderedExps.eq_dec x (Binop Sub (Var R 1) (Var R 2))
then DeltaMap (Binop Sub (toRExp e1) (toRExp e2)) m
(fun x _ => if Req_dec_sum x (evalBinop Sub nF1 nF2)
then DeltaMap (evalBinop Sub nF1 nF2) m
else None)
(toRExp (Binop Sub (Var Q 1) (Var Q 2))) nF m ->
validErrorbound (Binop Sub e1 e2) Gamma A dVars = true ->
......@@ -881,8 +881,8 @@ Lemma validErrorboundCorrectMult E1 E2 A
(updDefVars (Binop Mult (Var R 1) (Var R 2)) m
(updDefVars (Var Rdefinitions.R 2) m2
(updDefVars (Var Rdefinitions.R 1) m1 (toRExpMap Gamma))))
(fun x _ => if R_orderedExps.eq_dec x (Binop Mult (Var R 1) (Var R 2))
then DeltaMap (Binop Mult (toRExp e1) (toRExp e2)) m
(fun x _ => if Req_dec_sum x (evalBinop Mult nF1 nF2)
then DeltaMap (evalBinop Mult nF1 nF2) m
else None)
(toRExp (Binop Mult (Var Q 1) (Var Q 2))) nF m ->
validErrorbound (Binop Mult e1 e2) Gamma A dVars = true ->
......@@ -949,8 +949,8 @@ Lemma validErrorboundCorrectDiv E1 E2 A
(updDefVars (Binop Div (Var R 1) (Var R 2)) m
(updDefVars (Var Rdefinitions.R 2) m2
(updDefVars (Var Rdefinitions.R 1) m1 (toRExpMap Gamma))))
(fun x _ => if R_orderedExps.eq_dec x (Binop Div (Var R 1) (Var R 2))
then DeltaMap (Binop Div (toRExp e1) (toRExp e2)) m
(fun x _ => if Req_dec_sum x (evalBinop Div nF1 nF2)
then DeltaMap (evalBinop Div nF1 nF2) m
else None)
(toRExp (Binop Div (Var Q 1) (Var Q 2))) nF m ->
validErrorbound (Binop Div e1 e2) Gamma A dVars = true ->
......@@ -1866,8 +1866,8 @@ Lemma validErrorboundCorrectFma E1 E2 A
(updDefVars (Var Rdefinitions.R 3) m3
(updDefVars (Var Rdefinitions.R 2) m2
(updDefVars (Var Rdefinitions.R 1) m1 (toRExpMap Gamma)))))
(fun x _ => if R_orderedExps.eq_dec x (Fma (Var R 1) (Var R 2) (Var R 3))
then DeltaMap (Fma (toRExp e1) (toRExp e2) (toRExp e3)) m
(fun x _ => if Req_dec_sum x (evalFma nF1 nF2 nF3)
then DeltaMap (evalFma nF1 nF2 nF3) m
else None)
(toRExp (Fma (Var Q 1) (Var Q 2) (Var Q 3))) nF m ->
validErrorbound (Fma e1 e2 e3) Gamma A dVars = true ->
......@@ -1953,8 +1953,8 @@ Lemma validErrorboundCorrectRounding E1 E2 A (e: expr Q) (nR nF nF1: R)
eval_Fin E2 Gamma DeltaMap e nF1 m ->
eval_expr (updEnv 1 nF1 emptyEnv)
(updDefVars (Downcast mEps (Var R 1)) mEps (updDefVars (Var R 1) m (toRExpMap Gamma)))
(fun x _ => if R_orderedExps.eq_dec x (Downcast mEps (Var R 1))
then DeltaMap (toRExp (Downcast mEps e)) mEps
(fun x _ => if Req_dec_sum x nF1
then DeltaMap nF1 mEps
else None)
(toRExp (Downcast mEps (Var Q 1))) nF mEps ->
validErrorbound (Downcast mEps e) Gamma A dVars = true ->
......@@ -1994,18 +1994,16 @@ Qed.
Each case requires the application of one of the soundness lemmata proven before
**)
Theorem validErrorbound_sound (e:expr Q):
forall E1 E2 fVars dVars A Gamma DeltaMap,
(forall (e' : expr R) (m' : mType),
exists d : R, DeltaMap e' m' = Some d /\ (Rabs d <= mTypeToR m')%R) ->
forall E1 E2 fVars dVars A Gamma,
validTypes e Gamma ->
approxEnv E1 (toRExpMap Gamma) A fVars dVars E2 ->
NatSet.Subset (NatSet.diff (Expressions.usedVars e) dVars) fVars ->
validErrorbound e Gamma A dVars = true ->
validRanges e A E1 (toRTMap (toRExpMap Gamma)) ->
validErrorBounds e E1 E2 A Gamma DeltaMap.
validErrorBounds e E1 E2 A Gamma.
Proof.
revert e; induction e;
intros * deltas_matched typing_ok approxCEnv fVars_subset valid_error valid_intv.
intros * typing_ok approxCEnv fVars_subset valid_error valid_intv DeltaMap.
- split; auto.
intros nR (elo, ehi) err eval_real A_eq.
split.
......@@ -2015,15 +2013,15 @@ Proof.
intros nR (elo, ehi) err eval_real A_eq.
pose proof (validRanges_single _ _ _ _ valid_intv) as valid_const.
destruct valid_const as [? [ ? [? [? [? ?]]]]].
rewrite H in A_eq; inversion A_eq; subst.
rewrite (meps_0_deterministic _ eval_real H0) in *; auto.
rewrite H0 in A_eq; inversion A_eq; subst.
rewrite (meps_0_deterministic _ eval_real H1) in *; auto.
split.
+ eapply validErrorboundCorrectConstant_eval; eauto.
+ intros * eval_float.
eapply validErrorboundCorrectConstant with (E2 := E2) (DeltaMap := DeltaMap); eauto.
inversion eval_float; subst; auto.
- rename IHe into IHe'.
assert (validErrorBounds e E1 E2 A Gamma DeltaMap) as IHe.
assert (validErrorBounds e E1 E2 A Gamma) as IHe.
{
eapply IHe'; eauto.
- specialize typing_ok as (? & ?).
......@@ -2045,19 +2043,20 @@ Proof.
destruct valid_intv as [valid_rec [iv [err_e [vR [? [? ?]]]]]].
inversion eval_real; subst.
assert (m0 = REAL) by (eapply toRTMap_eval_REAL; eauto); subst.
apply validErrorBounds_single with (v__R := v1) (iv := i) (err := e0) in IHe; eauto.
specialize (IHe _ H).
apply validErrorBoundsRec_single with (v__R := v1) (iv := i) (err := e0) in IHe; eauto.
specialize IHe as [[nF [mF eval_float]] valid_bounds_e].
split.
* inversion H; subst.
* inversion H0; subst.
exists (evalUnop Neg nF); exists mU.
eapply Unop_neg'; eauto.
{ eapply toRExpMap_some; eauto. simpl; auto. }
{ destruct H1 as [? [? ?]].
apply validTypes_single in H0.
destruct H0 as [? [? ?]].
{ destruct H2 as [? [? ?]].
apply validTypes_single in H1.
destruct H1 as [? [? ?]].
assert (x0 = x) by congruence; subst.
assert (mF = x).
{ eapply H14; eauto. }
{ eapply H15; eauto. }
subst; auto. }
* intros * eval_float_op.
inversion eval_float_op; subst; simpl.
......@@ -2065,7 +2064,7 @@ Proof.
canonize_hyps.
rewrite R0; eapply valid_bounds_e; eauto.
- rename IHe1 into IHe1'; rename IHe2 into IHe2'.
assert (validErrorBounds e1 E1 E2 A Gamma DeltaMap) as IHe1.
assert (validErrorBounds e1 E1 E2 A Gamma) as IHe1.
{
eapply IHe1'; eauto.
- specialize typing_ok as (? & ?).
......@@ -2077,7 +2076,7 @@ Proof.
intuition.
}
clear IHe1'.
assert (validErrorBounds e2 E1 E2 A Gamma DeltaMap) as IHe2.
assert (validErrorBounds e2 E1 E2 A Gamma) as IHe2.
{
eapply IHe2'; eauto.
- specialize typing_ok as (? & ?).
......@@ -2098,16 +2097,18 @@ Proof.
destruct typing_ok as [? [? [[? [? ?]] ?]]]; auto.
inversion eval_real; subst.
assert (m1 = REAL /\ m2 = REAL) as [? ?] by (split; eapply toRTMap_eval_REAL; eauto); subst.
apply validErrorBounds_single with (v__R := v1) (iv := i) (err := e) in IHe1; eauto.
specialize (IHe1 _ H).
apply validErrorBoundsRec_single with (v__R := v1) (iv := i) (err := e) in IHe1; eauto.
specialize IHe1 as [[nF1 [mF1 eval_float1]] valid_bounds_e1].
apply validErrorBounds_single with (v__R := v2) (iv := i0) (err := e0) in IHe2; eauto.
specialize (IHe2 _ H).
apply validErrorBoundsRec_single with (v__R := v2) (iv := i0) (err := e0) in IHe2; eauto.
specialize IHe2 as [[nF2 [mF2 eval_float2]] valid_bounds_e2].
apply validRanges_single in valid_e1;
apply validRanges_single in valid_e2.
destruct valid_e1 as [iv1 [ err1 [v1' [map_e1 [eval_real_e1 bounds_e1]]]]].
destruct valid_e2 as [iv2 [ err2 [v2' [map_e2 [eval_real_e2 bounds_e2]]]]].
pose proof (meps_0_deterministic _ eval_real_e1 H11); subst.
pose proof (meps_0_deterministic _ eval_real_e2 H14); subst.
pose proof (meps_0_deterministic _ eval_real_e1 H12); subst.
pose proof (meps_0_deterministic _ eval_real_e2 H15); subst.
rewrite map_e1, map_e2 in *.
inversion Heqo0; inversion Heqo1; subst.
rename i into iv1; rename e into err1; rename i0 into iv2;
......@@ -2130,12 +2131,12 @@ Proof.
destruct L0 as [nodivzero | nodivzero];
apply Qlt_Rlt in nodivzero;
try rewrite Q2R_plus in *; try rewrite Q2R_minus in *; lra. }
destruct H2 as [m1 [m2 [? [? valid_join]]]].
assert (m1 = mF1) by (eapply validTypes_exec in H0; eauto);
assert (m2 = mF2) by (eapply validTypes_exec in H1; eauto);
destruct H3 as [m1 [m2 [? [? valid_join]]]].
assert (m1 = mF1) by (eapply validTypes_exec in H1; eauto);
assert (m2 = mF2) by (eapply validTypes_exec in H2; eauto);
subst.
split.
+ specialize (deltas_matched (toRExp (Binop b e1 e2)) x)
+ specialize (H (evalBinop b nF1 nF2) x)
as (delta' & delta_matched' & delta_bound').
exists (perturb (evalBinop b nF1 nF2) x delta'), x.
eapply Binop_dist' with (delta:= delta'); eauto.
......@@ -2143,7 +2144,7 @@ Proof.
+ intros * eval_float.
clear eval_float1 eval_float2.
inversion eval_float; subst.
eapply (binary_unfolding H23 H18 H16 H19 H22) in eval_float; try auto.
eapply (binary_unfolding H24 H19 H17 H20 H23) in eval_float; try auto.
destruct b.
* eapply (validErrorboundCorrectAddition (e1:=e1) A); eauto.
{ cbn. instantiate (1:=dVars); Flover_compute.
......@@ -2170,7 +2171,7 @@ Proof.
{ destruct iv2; auto. }
{ eapply toRExpMap_find_map; eauto. }
- rename IHe1 into IHe1'; rename IHe2 into IHe2'; rename IHe3 into IHe3'.
assert (validErrorBounds e1 E1 E2 A Gamma DeltaMap) as IHe1.
assert (validErrorBounds e1 E1 E2 A Gamma) as IHe1.
{
eapply IHe1'; eauto.
- specialize typing_ok as (? & ?).
......@@ -2181,7 +2182,7 @@ Proof.
- cbn in valid_intv.
intuition.
}
assert (validErrorBounds e2 E1 E2 A Gamma DeltaMap) as IHe2.
assert (validErrorBounds e2 E1 E2 A Gamma) as IHe2.
{
eapply IHe2'; eauto.
- specialize typing_ok as (? & ?).
......@@ -2192,7 +2193,7 @@ Proof.
- cbn in valid_intv.
intuition.
}
assert (validErrorBounds e3 E1 E2 A Gamma DeltaMap) as IHe3.
assert (validErrorBounds e3 E1 E2 A Gamma) as IHe3.
{
eapply IHe3'; eauto.
- specialize typing_ok as (? & ?).
......@@ -2218,11 +2219,14 @@ Proof.
inversion eval_real; subst.
assert (m0 = REAL /\ m4 = REAL /\ m5 = REAL) as [? [? ?]]
by (repeat split; eapply toRTMap_eval_REAL; eauto); subst.
apply validErrorBounds_single with (v__R := v1) (iv := i) (err := e) in IHe1; eauto.
specialize (IHe1 _ H).
apply validErrorBoundsRec_single with (v__R := v1) (iv := i) (err := e) in IHe1; eauto.
specialize IHe1 as [[nF1 [mF1 eval_float1]] valid_bounds_e1].
apply validErrorBounds_single with (v__R := v2) (iv := i0) (err := e0) in IHe2; eauto.
specialize (IHe2 _ H).
apply validErrorBoundsRec_single with (v__R := v2) (iv := i0) (err := e0) in IHe2; eauto.
specialize IHe2 as [[nF2 [mF2 eval_float2]] valid_bounds_e2].
apply validErrorBounds_single with (v__R := v3) (iv := i1) (err := e4) in IHe3; eauto.
specialize (IHe3 _ H).
apply validErrorBoundsRec_single with (v__R := v3) (iv := i1) (err := e4) in IHe3; eauto.
specialize IHe3 as [[nF3 [mF3 eval_float3]] valid_bounds_e3].
assert (m1 = mF1) by (eapply validTypes_exec in find_m1; eauto).
assert (m2 = mF2) by (eapply validTypes_exec in find_m2; eauto).
......@@ -2233,9 +2237,9 @@ Proof.
destruct valid_e1 as [iv1 [ err1 [v1' [map_e1 [eval_real_e1 bounds_e1]]]]].
destruct valid_e2 as [iv2 [ err2 [v2' [map_e2 [eval_real_e2 bounds_e2]]]]].
destruct valid_e3 as [iv3 [ err3 [v3' [map_e3 [eval_real_e3 bounds_e3]]]]].
pose proof (meps_0_deterministic _ eval_real_e1 H6); subst.
pose proof (meps_0_deterministic _ eval_real_e2 H9); subst.
pose proof (meps_0_deterministic _ eval_real_e3 H10); subst.
pose proof (meps_0_deterministic _ eval_real_e1 H7); subst.
pose proof (meps_0_deterministic _ eval_real_e2 H10); subst.
pose proof (meps_0_deterministic _ eval_real_e3 H11); subst.
rewrite map_e1, map_e2, map_e3 in *.
inversion Heqo0; inversion Heqo1; inversion Heqo2; subst.
rename i into iv1; rename e into err1; rename i0 into iv2;
......@@ -2253,13 +2257,13 @@ Proof.
{ eapply distance_gives_iv; simpl;
try eauto. }
split.
+ specialize (deltas_matched (toRExp (Fma e1 e2 e3)) mG) as (delta' & delta_some' & delta_bound').
+ specialize (H (evalFma nF1 nF2 nF3) mG) as (delta' & delta_some' & delta_bound').
eexists; exists mG; econstructor; eauto.
eapply toRExpMap_some; eauto. simpl; auto.
+ intros * eval_float.
clear eval_float1 eval_float2 eval_float3.
inversion eval_float; subst.
eapply (fma_unfolding H12 H8 H13 H16 H17) in eval_float; try auto.
eapply (fma_unfolding H13 H9 H14 H17 H18) in eval_float; try auto.
eapply (validErrorboundCorrectFma (e1:=e1) (e2:=e2) (e3:=e3) A); eauto.
{ simpl.
rewrite A_eq.
......@@ -2273,7 +2277,7 @@ Proof.
{ destruct iv3; auto. }
{ eapply toRExpMap_find_map; eauto. }
- rename IHe into IHe'.
assert (validErrorBounds e E1 E2 A Gamma DeltaMap) as IHe.
assert (validErrorBounds e E1 E2 A Gamma) as IHe.
{
eapply IHe'; eauto.
- specialize typing_ok as (? & ?).
......@@ -2288,20 +2292,21 @@ Proof.
intros nR (elo, ehi) err eval_real A_eq.
cbn in *; Flover_compute; try congruence; type_conv; subst.
inversion eval_real; subst.
apply REAL_least_precision in H3; subst.
apply REAL_least_precision in H4; subst.
destruct i as [ivlo_e ivhi_e]; rename e0 into err_e.
destruct valid_intv as [valid_e1 valid_intv].
destruct typing_ok as [mG [find_m [[valid_e [? [m1 [find_e1 morePrecise_m1]]]] valid_exec]]].
apply validErrorBounds_single with (v__R := v1) (iv := (ivlo_e, ivhi_e)) (err := err_e) in IHe;
specialize (IHe _ H).
apply validErrorBoundsRec_single with (v__R := v1) (iv := (ivlo_e, ivhi_e)) (err := err_e) in IHe;
eauto.
specialize IHe as [[vF [mF eval_float_e]] bounded_e].
assert (mF = m1) by (eapply validTypes_exec in find_e1; eauto); subst.
apply validRanges_single in valid_e1.
destruct valid_e1 as [iv1' [err1' [v1' [map_e [eval_real_e bounds_e]]]]].
rewrite map_e in Heqo0; inversion Heqo0; subst.
pose proof (meps_0_deterministic _ eval_real_e H6); subst. clear H6.
pose proof (meps_0_deterministic _ eval_real_e H7); subst. clear H7.
split.
+ specialize (deltas_matched (toRExp (Downcast mG e)) mG)
+ specialize (H vF mG)
as (delta' & delta_some' & delta_bound').
eexists; eexists.
eapply Downcast_dist'; eauto.
......@@ -2311,8 +2316,8 @@ Proof.
eapply validErrorboundCorrectRounding; eauto.
* simpl. eapply Downcast_dist'; eauto.
{ constructor; cbn; auto. }
{ pose proof (R_orderedExps.eq_refl (Downcast m__FP (Var R 1))).
destruct R_orderedExps.eq_dec as [Heq|Hneq]; auto; congruence. }
{ destruct Req_dec_sum as [? | Hneq]; auto.
contradiction Hneq; auto. }
{ unfold updDefVars; cbn. rewrite mTypeEq_refl. auto. }
* cbn; instantiate (1:=dVars); Flover_compute.
rewrite L, L0; auto.
......@@ -2321,8 +2326,8 @@ Qed.
Theorem validErrorboundCmd_gives_eval (f:cmd Q) :
forall (A:analysisResult) E1 E2 outVars fVars dVars vR elo ehi err Gamma DeltaMap,
(forall (e' : expr R) (m' : mType),
exists d : R, DeltaMap e' m' = Some d /\ (Rabs d <= mTypeToR m')%R) ->
(forall (v : R) (m' : mType),
exists d : R, DeltaMap v m' = Some d /\ (Rabs d <= mTypeToR m')%R) ->
approxEnv E1 (toRExpMap Gamma) A fVars dVars E2 ->
ssa f (NatSet.union fVars dVars) outVars ->
NatSet.Subset (NatSet.diff (Commands.freeVars f) dVars) fVars ->
......@@ -2349,7 +2354,7 @@ Proof.
hnf; intros; subst; set_tac. }
destruct i as [ivlo_e ivhi_e]; rename e0 into err_e.
eapply validErrorbound_sound in L0; eauto.
eapply validErrorBounds_single in L0; eauto.
eapply validErrorBoundsRec_single in L0; eauto.
destruct L0 as [[vF [ mF eval_float_e]] bounded_e].
canonize_hyps.
destruct valid_types
......@@ -2409,27 +2414,25 @@ Proof.
unfold validErrorboundCmd in valid_bounds.
destruct valid_intv.
destruct valid_types.
assert (validErrorBounds e E1 E2 A Gamma DeltaMap) as Hsound
assert (validErrorBounds e E1 E2 A Gamma) as Hsound
by (eapply validErrorbound_sound; eauto).
eapply validErrorBounds_single in Hsound; eauto.
eapply validErrorBoundsRec_single in Hsound; eauto.
edestruct Hsound as [[vF [mF eval_e]] bounded_e]; eauto.
exists vF; exists mF; econstructor; eauto.
Qed.
Theorem validErrorboundCmd_sound (f:cmd Q):
forall A E1 E2 outVars fVars dVars Gamma DeltaMap,
(forall (e' : expr R) (m' : mType),
exists d : R, DeltaMap e' m' = Some d /\ (Rabs d <= mTypeToR m')%R) ->
forall A E1 E2 outVars fVars dVars Gamma,
approxEnv E1 (toRExpMap Gamma) A fVars dVars E2 ->