Skip to content

GitLab

F
FloVer
Commit bac7151e authored by Joachim Bard's avatar Joachim Bard
Browse files
Options

Merge remote-tracking branch 'upstream/master' 

merge with Nikita's changes
parents 923d82d0 cad900bc
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 473 additions and 289 deletions
coq/CertificateChecker.v
View file @ bac7151e
......@@ -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.
......
coq/Commands.v
View file @ bac7151e
......@@ -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 ->
......
coq/ErrorAnalysis.v
View file @ bac7151e
......@@ -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.
coq/ErrorBounds.v
View file @ bac7151e
......@@ -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 ->
......
coq/ErrorValidation.v
View file @ bac7151e
This diff is collapsed.
coq/ErrorValidationAA.v
View file @ bac7151e
This diff is collapsed.
coq/ExpressionSemantics.v
View file @ bac7151e
......@@ -34,16 +34,16 @@ Open Scope R_scope.
Inductive eval_expr (E:env)
(Gamma: expr R -> option mType)
(DeltaMap: expr R -> mType -> option R)
(DeltaMap: R -> mType -> option R)
:(expr R) -> R -> mType -> Prop :=
| Var_load m x v:
Gamma (Var R x) = Some m ->
E x = Some v ->
eval_expr E Gamma DeltaMap (Var R x) v m
| Const_dist m n delta:
DeltaMap (Const m n) m = Some delta ->
| Const_dist m c delta:
DeltaMap c m = Some delta ->
Rabs delta <= mTypeToR m ->
eval_expr E Gamma DeltaMap (Const m n) (perturb n m delta) m
eval_expr E Gamma DeltaMap (Const m c) (perturb c m delta) m
| Unop_neg m mN f1 v1:
Gamma (Unop Neg f1) = Some mN ->
isCompat m mN = true ->
......@@ -51,7 +51,7 @@ Inductive eval_expr (E:env)
eval_expr E Gamma DeltaMap (Unop Neg f1) (evalUnop Neg v1) mN
| Unop_inv m mN f1 v1 delta:
Gamma (Unop Inv f1) = Some mN ->
DeltaMap (Unop Inv f1) mN = Some delta ->
DeltaMap (evalUnop Inv v1) mN = Some delta ->
isCompat m mN = true ->
Rabs delta <= mTypeToR mN ->
eval_expr E Gamma DeltaMap f1 v1 m ->
......@@ -59,14 +59,14 @@ Inductive eval_expr (E:env)
eval_expr E Gamma DeltaMap (Unop Inv f1) (perturb (evalUnop Inv v1) mN delta) mN
| Downcast_dist m m1 f1 v1 delta:
Gamma (Downcast m f1) = Some m ->
DeltaMap (Downcast m f1) m = Some delta ->
DeltaMap v1 m = Some delta ->
isMorePrecise m1 m = true ->
Rabs delta <= mTypeToR m ->
eval_expr E Gamma DeltaMap f1 v1 m1 ->
eval_expr E Gamma DeltaMap (Downcast m f1) (perturb v1 m delta) m
| Binop_dist m1 m2 op f1 f2 v1 v2 delta m:
Gamma (Binop op f1 f2) = Some m ->
DeltaMap (Binop op f1 f2) m = Some delta ->
DeltaMap (evalBinop op v1 v2) m = Some delta ->
isJoin m1 m2 m = true ->
Rabs delta <= mTypeToR m ->
eval_expr E Gamma DeltaMap f1 v1 m1 ->
......@@ -75,7 +75,7 @@ Inductive eval_expr (E:env)
eval_expr E Gamma DeltaMap (Binop op f1 f2) (perturb (evalBinop op v1 v2) m delta) m
| Fma_dist m1 m2 m3 m f1 f2 f3 v1 v2 v3 delta:
Gamma (Fma f1 f2 f3) = Some m ->
DeltaMap (Fma f1 f2 f3) m = Some delta ->
DeltaMap (evalFma v1 v2 v3) m = Some delta ->
isJoin3 m1 m2 m3 m = true ->
Rabs delta <= mTypeToR m ->
eval_expr E Gamma DeltaMap f1 v1 m1 ->
......@@ -83,7 +83,7 @@ Inductive eval_expr (E:env)
eval_expr E Gamma DeltaMap f3 v3 m3 ->
eval_expr E Gamma DeltaMap (Fma f1 f2 f3) (perturb (evalFma v1 v2 v3) m delta) m.
Definition DeltaMapR: expr R -> mType -> option R := (fun x m => Some 0).
Definition DeltaMapR: R -> mType -> option R := (fun x m => Some 0).
Close Scope R_scope.
......@@ -92,12 +92,12 @@ Hint Constructors eval_expr.
(** *)
(* Show some simpler (more general) rule lemmata *)
(* **)
Lemma Const_dist' DeltaMap m n delta v m' E Gamma:
Lemma Const_dist' DeltaMap m c delta v m' E Gamma:
Rle (Rabs delta) (mTypeToR m') ->
DeltaMap (Const m n) m = Some delta ->
v = perturb n m delta ->
DeltaMap c m = Some delta ->
v = perturb c m delta ->
m' = m ->
eval_expr E Gamma DeltaMap (Const m n) v m'.
eval_expr E Gamma DeltaMap (Const m c) v m'.
Proof.
intros; subst; auto.
Qed.
......@@ -120,7 +120,7 @@ Hint Resolve Unop_neg'.
Lemma Unop_inv' DeltaMap m mN f1 v1 delta v m' E Gamma:
Rle (Rabs delta) (mTypeToR m') ->
eval_expr E Gamma DeltaMap f1 v1 m ->
DeltaMap (Unop Inv f1) m' = Some delta ->
DeltaMap (evalUnop Inv v1) m' = Some delta ->
(~ v1 = 0)%R ->
v = perturb (evalUnop Inv v1) mN delta ->
Gamma (Unop Inv f1) = Some mN ->
......@@ -137,7 +137,7 @@ Lemma Downcast_dist' DeltaMap m m1 f1 v1 delta v m' E Gamma:
isMorePrecise m1 m = true ->
Rle (Rabs delta) (mTypeToR m') ->
eval_expr E Gamma DeltaMap f1 v1 m1 ->
DeltaMap (Downcast m f1) m' = Some delta ->
DeltaMap v1 m' = Some delta ->
v = (perturb v1 m delta) ->
Gamma (Downcast m f1) = Some m ->
m' = m ->
......@@ -152,7 +152,7 @@ Lemma Binop_dist' DeltaMap m1 m2 op f1 f2 v1 v2 delta v m m' E Gamma:
Rle (Rabs delta) (mTypeToR m') ->
eval_expr E Gamma DeltaMap f1 v1 m1 ->
eval_expr E Gamma DeltaMap f2 v2 m2 ->
DeltaMap (Binop op f1 f2) m' = Some delta ->
DeltaMap (evalBinop op v1 v2) m' = Some delta ->
((op = Div) -> (~ v2 = 0)%R) ->
v = perturb (evalBinop op v1 v2) m' delta ->
Gamma (Binop op f1 f2) = Some m ->
......@@ -170,7 +170,7 @@ Lemma Fma_dist' DeltaMap m1 m2 m3 f1 f2 f3 v1 v2 v3 delta v m' E Gamma m:
eval_expr E Gamma DeltaMap f1 v1 m1 ->
eval_expr E Gamma DeltaMap f2 v2 m2 ->
eval_expr E Gamma DeltaMap f3 v3 m3 ->
DeltaMap (Fma f1 f2 f3) m' = Some delta ->
DeltaMap (evalFma v1 v2 v3) m' = Some delta ->
v = perturb (evalFma v1 v2 v3) m' delta ->
Gamma (Fma f1 f2 f3) = Some m ->
isJoin3 m1 m2 m3 m = true ->
......@@ -293,15 +293,15 @@ variables in the Environment.
Lemma binary_unfolding b f1 f2 E v1 v2 m1 m2 m Gamma DeltaMap delta:
(b = Div -> ~(v2 = 0 )%R) ->
(Rabs delta <= mTypeToR m)%R ->
DeltaMap (Binop b f1 f2) m = Some delta ->
DeltaMap (evalBinop b v1 v2) m = Some delta ->
eval_expr E Gamma DeltaMap f1 v1 m1 ->
eval_expr E Gamma DeltaMap f2 v2 m2 ->
eval_expr E Gamma DeltaMap (Binop b f1 f2) (perturb (evalBinop b v1 v2) m delta) m ->
eval_expr (updEnv 2 v2 (updEnv 1 v1 emptyEnv))
(updDefVars (Binop b (Var R 1) (Var R 2)) m
(updDefVars (Var R 2) m2 (updDefVars (Var R 1) m1 Gamma)))
(fun x _ => if R_orderedExps.eq_dec x (Binop b (Var R 1) (Var R 2))
then DeltaMap (Binop b f1 f2) m
(fun x _ => if Req_dec_sum x (evalBinop b v1 v2)
then DeltaMap (evalBinop b v1 v2) m
else None)
(Binop b (Var R 1) (Var R 2)) (perturb (evalBinop b v1 v2) m delta) m.
Proof.
......@@ -319,15 +319,15 @@ Proof.
eapply Binop_dist' with (v1:=v1) (v2:=v2) (delta:=delta); try eauto.
- eapply Var_load; eauto.
- eapply Var_load; eauto.
- destruct R_orderedExps.eq_dec as [?|H]; auto.
exfalso; apply H; apply R_orderedExps.eq_refl.
- destruct Req_dec_sum as [?|H]; auto.
exfalso; now apply H.
- unfold updDefVars.
unfold R_orderedExps.compare; rewrite R_orderedExps.exprCompare_refl; auto.
Qed.
Lemma fma_unfolding f1 f2 f3 E v1 v2 v3 m1 m2 m3 m Gamma DeltaMap delta:
(Rabs delta <= mTypeToR m)%R ->
DeltaMap (Fma f1 f2 f3) m = Some delta ->
DeltaMap (evalFma v1 v2 v3) m = Some delta ->
eval_expr E Gamma DeltaMap f1 v1 m1 ->
eval_expr E Gamma DeltaMap f2 v2 m2 ->
eval_expr E Gamma DeltaMap f3 v3 m3 ->
......@@ -336,8 +336,8 @@ Lemma fma_unfolding f1 f2 f3 E v1 v2 v3 m1 m2 m3 m Gamma DeltaMap delta:
(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 Gamma))))
(fun x _ => if R_orderedExps.eq_dec x (Fma (Var R 1) (Var R 2) (Var R 3))
then DeltaMap (Fma f1 f2 f3) m
(fun x _ => if Req_dec_sum x (evalFma v1 v2 v3)
then DeltaMap (evalFma v1 v2 v3) m
else None)
(Fma (Var R 1) (Var R 2) (Var R 3)) (perturb (evalFma v1 v2 v3) m delta) m.
Proof.
......@@ -357,7 +357,9 @@ Proof.
- eapply Var_load; eauto.
- eapply Var_load; eauto.
- eapply Var_load; eauto.
- cbn; auto.
- destruct Req_dec_sum as [? | Hneq]; auto.
contradiction Hneq; auto.
- now cbn.
Qed.
Lemma eval_eq_env e:
......@@ -476,21 +478,29 @@ Proof.
- destruct u; inversion Heval1; inversion Heval2; subst.
+ f_equal; eapply IHe; eauto.
erewrite Gamma_det; eauto.
+ replace delta with delta0 by congruence.
f_equal; f_equal; eapply IHe; eauto.
erewrite Gamma_det; eauto.
+ replace m0 with m in * by (eapply Gamma_det; eauto).
replace v3 with v0 in * by (eapply IHe; eauto).
replace delta with delta0 by congruence.
reflexivity.
- inversion Heval1; inversion Heval2; subst.
replace delta with delta0 by congruence.
f_equal; f_equal; [eapply IHe1 | eapply IHe2]; eauto;
erewrite Gamma_det; eauto.
replace m1 with m0 in * by (eapply Gamma_det; eauto).
replace m3 with m2 in * by (eapply Gamma_det; eauto).
replace v4 with v0 in * by (eapply IHe1; eauto).
replace v5 with v3 in * by (eapply IHe2; eauto).
now replace delta with delta0 by congruence.
- inversion Heval1; inversion Heval2; subst.
replace delta with delta0 by congruence.
f_equal; f_equal; [eapply IHe1 | eapply IHe2 | eapply IHe3]; eauto;
erewrite Gamma_det; eauto.
replace m1 with m0 in * by (eapply Gamma_det; eauto).
replace m4 with m2 in * by (eapply Gamma_det; eauto).
replace m5 with m3 in * by (eapply Gamma_det; eauto).
replace v5 with v0 in * by (eapply IHe1; eauto).
replace v6 with v3 in * by (eapply IHe2; eauto).
replace v7 with v4 in * by (eapply IHe3; eauto).
now replace delta with delta0 by congruence.
- inversion Heval1; inversion Heval2; subst.
replace m3 with m1 in * by (eapply Gamma_det; eauto).
replace v3 with v0 in * by (eapply IHe; eauto).
replace delta with delta0 by congruence.
f_equal; f_equal; eapply IHe; eauto;
erewrite Gamma_det; eauto.
reflexivity.
Qed.
Lemma real_eval_expr_ignores_delta_map (f:expr R) (E:env) Gamma:
......
coq/FPRangeValidator.v
View file @ bac7151e
......@@ -71,13 +71,13 @@ Ltac prove_fprangeval m v L1 R:=
Theorem FPRangeValidator_sound:
forall (e:expr Q) E1 E2 Gamma DeltaMap v m A fVars dVars,
(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 ->
eval_expr E2 (toRExpMap Gamma) DeltaMap (toRExp e) v m ->
validTypes e Gamma ->
validRanges e A E1 (toRTMap (toRExpMap Gamma)) ->
validErrorBounds e E1 E2 A Gamma DeltaMap ->
validErrorBoundsRec e E1 E2 A Gamma DeltaMap ->
FPRangeValidator e A Gamma dVars = true ->
NatSet.Subset (NatSet.diff (usedVars e) dVars) fVars ->
(forall v, NatSet.In v dVars ->
......@@ -98,7 +98,7 @@ Proof.
destruct valid_e as [iv_e [err_e [vR[ map_e[eval_real vR_bounded]]]]].
destruct iv_e as [e_lo e_hi].
assert (Rabs (vR - v) <= Q2R (err_e))%R.
{ eapply validErrorBounds_single; eauto. }
{ eapply validErrorBoundsRec_single; eauto. }
destruct (distance_gives_iv (a:=vR) v (e:=Q2R err_e) (Q2R e_lo, Q2R e_hi))
as [v_in_errIv];
try auto.
......@@ -146,15 +146,15 @@ Qed.
Lemma FPRangeValidatorCmd_sound (f:cmd Q):
forall E1 E2 Gamma DeltaMap v vR m A fVars dVars outVars,
(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 ->
bstep (toREvalCmd (toRCmd f)) E1 (toRTMap (toRExpMap Gamma)) DeltaMapR vR m ->
bstep (toRCmd f) E2 (toRExpMap Gamma) DeltaMap v m ->
validTypesCmd f Gamma ->
validRangesCmd f A E1 (toRTMap (toRExpMap Gamma)) ->
validErrorBoundsCmd f E1 E2 A Gamma DeltaMap ->
validErrorBoundsCmdRec f E1 E2 A Gamma DeltaMap ->
FPRangeValidatorCmd f A Gamma dVars = true ->
NatSet.Subset (NatSet.diff (freeVars f) dVars) fVars ->
(forall v, NatSet.In v dVars ->
......@@ -177,37 +177,27 @@ Proof.
pose proof (validRanges_single _ _ _ _ valid_e) as valid_e_single.
destruct valid_e_single
as [iv_e [err_e [vR_e [map_e [eval_e_real bounded_vR_e]]]]].
destruct H6 as ((validerr_e & validerr_rec) & validerr_single).
pose proof (validErrorBounds_single _ _ _ _ validerr_e) as validerr_e_single.
destruct H6 as ((validerr_e & validerr_rec) & validerr_single); auto.
pose proof (validErrorBoundsRec_single _ _ _ _ validerr_e) as validerr_e_single.
specialize (validerr_e_single v0 iv_e err_e H19 map_e) as
((vF_e & m_e & eval_float_e) & err_bounded_e).
(* destr_factorize.
edestruct (validErrorbound_sound (e:=e) (E1:=E1) (E2:=E2) (fVars:=fVars)
(dVars := dVars) (A:=A)
(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.
+ set_tac. split; try auto.
split; try auto.
hnf; intros; subst; set_tac.
+ destruct iv_e; auto.
+ *)
rewrite <- (meps_0_deterministic (toRExp e) eval_e_real H19) in *; try auto.
apply (IHf (updEnv n vR_e E1) (updEnv n v1 E2)
Gamma DeltaMap v vR m0 A fVars
(NatSet.add n dVars) (outVars)); eauto.
rewrite <- (meps_0_deterministic (toRExp e) eval_e_real H19) in *; try auto.
apply (IHf (updEnv n vR_e E1) (updEnv n v1 E2)
Gamma DeltaMap v vR m0 A fVars
(NatSet.add n dVars) (outVars)); eauto.
* destruct validerr_rec as [[iv_e2 [err_e2 [iv_x [err_x [find_e [find_x eqfind]]]]]] validerr_rec].
rewrite find_e in *; canonize_hyps. inversion map_e; subst.
eapply approxUpdBound; eauto; simpl in *.
{ eapply toRExpMap_some; eauto. simpl; auto. }
{ rewrite <- eqfind. eapply err_bounded_e. eauto. }
* eapply ssa_equal_set; eauto.
hnf. intros a; split; intros in_set.
{ rewrite NatSet.add_spec, NatSet.union_spec;
rewrite NatSet.union_spec, NatSet.add_spec in in_set.
destruct in_set as [P1 | [ P2 | P3]]; auto. }
{ rewrite NatSet.add_spec, NatSet.union_spec in in_set;
rewrite NatSet.union_spec, NatSet.add_spec.
destruct in_set as [P1 | [ P2 | P3]]; auto. }
{ eapply toRExpMap_some; eauto. simpl; auto. }
{ rewrite <- eqfind. eapply err_bounded_e. eauto. }
* eapply ssa_equal_set; eauto.
hnf. intros a; split; intros in_set.
{ rewrite NatSet.add_spec, NatSet.union_spec;
rewrite NatSet.union_spec, NatSet.add_spec in in_set.
destruct in_set as [P1 | [ P2 | P3]]; auto. }
{ rewrite NatSet.add_spec, NatSet.union_spec in in_set;
rewrite NatSet.union_spec, NatSet.add_spec.
destruct in_set as [P1 | [ P2 | P3]]; auto. }
(*
* eapply (swap_Gamma_bstep (Gamma1 := updDefVars n REAL (toRMap Gamma))); eauto.
eauto using Rmap_updVars_comm.
......@@ -215,13 +205,13 @@ Proof.
{ intros x; unfold toRMap, updDefVars.
destruct (x =? n) eqn:?; auto. }
{ eapply valid_rec. auto. } *)
* destruct validerr_rec; auto.
* set_tac; split.
{ split; try auto.
hnf; intros; subst.
apply H6; rewrite NatSet.add_spec; auto. }
{ hnf; intros.
apply H6; rewrite NatSet.add_spec; auto. }
* destruct validerr_rec; auto.
* set_tac; split.
{ split; try auto.
hnf; intros; subst.
apply H6; rewrite NatSet.add_spec; auto. }
{ hnf; intros.
apply H6; rewrite NatSet.add_spec; auto. }
(*
* unfold vars_typed. intros.
unfold updDefVars.
......@@ -231,17 +221,20 @@ Proof.
rewrite NatSet.add_spec in H4.
rewrite Nat.eqb_neq in *.
destruct H4; subst; try congruence; auto. *)
* intros. unfold updEnv.
type_conv; subst.
destruct (v2 =? n) eqn:?; try rewrite Nat.eqb_eq in *;
try rewrite Nat.eqb_neq in *.
{ exists v1; subst. exists m; repeat split; try auto.
eapply FPRangeValidator_sound; eauto.
set_tac. split; try auto.
split; try auto.
hnf; intros; subst; set_tac. }
{ apply H9.
rewrite NatSet.add_spec in H5; destruct H5;
auto; subst; congruence. }
- destruct H5. destruct H4. destruct H6. eapply FPRangeValidator_sound; eauto.
* intros. unfold updEnv.
type_conv; subst.
destruct (v2 =? n) eqn:?; try rewrite Nat.eqb_eq in *;
try rewrite Nat.eqb_neq in *.
{ exists v1; subst. exists m; repeat split; try auto.
eapply FPRangeValidator_sound; eauto.
set_tac. split; try auto.
split; try auto.
hnf; intros; subst; set_tac. }
{ apply H9.
rewrite NatSet.add_spec in H5; destruct H5;
auto; subst; congruence. }
- destruct H5.
destruct H4.
destruct H6; auto.
eapply FPRangeValidator_sound; eauto.
Qed.
coq/IEEE_connection.v
View file @ bac7151e
This diff is collapsed.
coq/RoundoffErrorValidator.v
View file @ bac7151e
......@@ -18,9 +18,7 @@ Definition RoundoffErrorValidator (e:expr Q) (tMap:FloverMap.t mType)
Theorem RoundoffErrorValidator_sound:
forall (e : expr Q) (E1 E2 : env) (fVars dVars : NatSet.t) (A : analysisResult)
(nR : R) (err : error) (iv : intv) (Gamma : FloverMap.t mType) DeltaMap,
(forall (e' : expr R) (m' : mType),
exists d : R, DeltaMap e' m' = Some d /\ (Rabs d <= mTypeToR m