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) ...@@ -30,8 +30,8 @@ Definition CertificateChecker (e:expr Q) (absenv:analysisResult)
**) **)
Theorem Certificate_checking_is_sound (e:expr Q) (absenv:analysisResult) P Qmap defVars: Theorem Certificate_checking_is_sound (e:expr Q) (absenv:analysisResult) P Qmap defVars:
forall (E1 E2:env) DeltaMap, forall (E1 E2:env) DeltaMap,
(forall (e' : expr R) (m' : mType), (forall (v : R) (m' : mType),
exists d : R, DeltaMap e' m' = Some d /\ (Rabs d <= mTypeToR m')%R) -> exists d : R, DeltaMap v m' = Some d /\ (Rabs d <= mTypeToR m')%R) ->
eval_precond E1 P -> eval_precond E1 P ->
unsat_queries Qmap -> unsat_queries Qmap ->
CertificateChecker e absenv P Qmap defVars = true -> CertificateChecker e absenv P Qmap defVars = true ->
...@@ -79,11 +79,11 @@ Proof. ...@@ -79,11 +79,11 @@ Proof.
destruct iv_e as [elo ehi]. destruct iv_e as [elo ehi].
exists Gamma; intros approxE1E2. exists Gamma; intros approxE1E2.
assert (dVars_contained NatSet.empty (FloverMap.empty (affine_form Q))) as Hdvars assert (dVars_contained NatSet.empty (FloverMap.empty (affine_form Q))) as Hdvars
by (unfold dVars_contained; intros * Hset; clear - Hset; set_tac). by (unfold dVars_contained; intros * Hset; clear - Hset; set_tac).
pose proof (RoundoffErrorValidator_sound e _ deltas_matched H approxE1E2 H1 eval_real R pose proof (RoundoffErrorValidator_sound e H approxE1E2 H1 eval_real R
valid_e map_e Hdvars) as Hsound. valid_e map_e Hdvars) as Hsound.
unfold validErrorBounds in 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. destruct Hsound as [[vF [mF eval_float]] err_bounded]; auto.
exists (elo, ehi), err_e, vR, vF, mF; repeat split; auto. exists (elo, ehi), err_e, vR, vF, mF; repeat split; auto.
Qed. Qed.
...@@ -105,8 +105,8 @@ Definition CertificateCheckerCmd (f:cmd Q) (absenv:analysisResult) (P: precond) ...@@ -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 Theorem Certificate_checking_cmds_is_sound (f:cmd Q) (absenv:analysisResult) P Qmap
defVars DeltaMap: defVars DeltaMap:
forall (E1 E2:env), forall (E1 E2:env),
(forall (e' : expr R) (m' : mType), (forall (v : R) (m' : mType),
exists d : R, DeltaMap e' m' = Some d /\ (Rabs d <= mTypeToR m')%R) -> exists d : R, DeltaMap v m' = Some d /\ (Rabs d <= mTypeToR m')%R) ->
eval_precond E1 P -> eval_precond E1 P ->
unsat_queries Qmap -> unsat_queries Qmap ->
CertificateCheckerCmd f absenv P Qmap defVars = true -> CertificateCheckerCmd f absenv P Qmap defVars = true ->
...@@ -160,7 +160,7 @@ Proof. ...@@ -160,7 +160,7 @@ Proof.
destruct iv as [f_lo f_hi]. destruct iv as [f_lo f_hi].
pose proof RoundoffErrorValidatorCmd_sound as Hsound. 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) & ?). - specialize Hsound as ((vF & mF & eval_float) & ?).
exists (f_lo, f_hi), err, vR, vF, mF; repeat split; try auto. exists (f_lo, f_hi), err, vR, vF, mF; repeat split; try auto.
- eapply ssa_equal_set. 2: exact ssa_f_small. - eapply ssa_equal_set. 2: exact ssa_f_small.
......
...@@ -48,7 +48,7 @@ Inductive sstep : cmd R -> env -> R -> cmd R -> env -> Prop := ...@@ -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" Define big step semantics for the Flover language, terminating on a "returned"
result value 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 := R -> mType -> Prop :=
let_b m m' x e s E v res defVars DeltaMap: let_b m m' x e s E v res defVars DeltaMap:
eval_expr E defVars DeltaMap e v m -> eval_expr E defVars DeltaMap e v m ->
......
...@@ -4,17 +4,17 @@ From Coq ...@@ -4,17 +4,17 @@ From Coq
From Flover From Flover
Require Import Commands ExpressionSemantics Environments RealRangeArith TypeValidator. 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 (match e with
| Unop u e => validErrorBounds e E1 E2 A Gamma DeltaMap | Unop u e => validErrorBoundsRec e E1 E2 A Gamma DeltaMap
| Downcast m e => validErrorBounds e E1 E2 A Gamma DeltaMap | Downcast m e => validErrorBoundsRec e E1 E2 A Gamma DeltaMap
| Binop b e1 e2 => | Binop b e1 e2 =>
validErrorBounds e1 E1 E2 A Gamma DeltaMap /\ validErrorBoundsRec e1 E1 E2 A Gamma DeltaMap /\
validErrorBounds e2 E1 E2 A Gamma DeltaMap validErrorBoundsRec e2 E1 E2 A Gamma DeltaMap
| Fma e1 e2 e3 => | Fma e1 e2 e3 =>
validErrorBounds e1 E1 E2 A Gamma DeltaMap /\ validErrorBoundsRec e1 E1 E2 A Gamma DeltaMap /\
validErrorBounds e2 E1 E2 A Gamma DeltaMap /\ validErrorBoundsRec e2 E1 E2 A Gamma DeltaMap /\
validErrorBounds e3 E1 E2 A Gamma DeltaMap validErrorBoundsRec e3 E1 E2 A Gamma DeltaMap
| _ => True | _ => True
end) /\ end) /\
forall v__R (iv: intv) (err: error), forall v__R (iv: intv) (err: error),
...@@ -26,8 +26,14 @@ Fixpoint validErrorBounds (e:expr Q) E1 E2 A Gamma DeltaMap :Prop := ...@@ -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 -> eval_expr E2 (toRExpMap Gamma) DeltaMap (toRExp e) v__FP m__FP ->
(Rabs (v__R - v__FP) <= (Q2R err))%R). (Rabs (v__R - v__FP) <= (Q2R err))%R).
Lemma validErrorBounds_single e E1 E2 A Gamma DeltaMap: Definition validErrorBounds e E1 E2 A Gamma: Prop :=
validErrorBounds e E1 E2 A Gamma DeltaMap -> 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, forall v__R iv err,
eval_expr E1 (toRTMap (toRExpMap Gamma)) DeltaMapR (toREval (toRExp e)) v__R REAL -> eval_expr E1 (toRTMap (toRExpMap Gamma)) DeltaMapR (toREval (toRExp e)) v__R REAL ->
FloverMap.find e A = Some (iv, err) -> FloverMap.find e A = Some (iv, err) ->
...@@ -39,13 +45,13 @@ Lemma validErrorBounds_single e E1 E2 A Gamma DeltaMap: ...@@ -39,13 +45,13 @@ Lemma validErrorBounds_single e E1 E2 A Gamma DeltaMap:
Proof. Proof.
intros validError_e; intros validError_e;
intros; destruct e; cbn in *; split; intros; destruct e; cbn in *; split;
destruct validError_e as (? & ? & ?); eauto. edestruct validError_e as (? & ? & ?); eauto.
Qed. 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 match c with
| Let m x e k => | 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, (exists iv_e err_e iv_x err_x,
FloverMap.find e A = Some (iv_e, err_e) /\ FloverMap.find e A = Some (iv_e, err_e) /\
FloverMap.find (Var Q x) A = Some (iv_x, err_x) /\ 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 := ...@@ -53,8 +59,8 @@ Fixpoint validErrorBoundsCmd (c: cmd Q) E1 E2 A Gamma DeltaMap: Prop :=
(forall v__R v__FP, (forall v__R v__FP,
eval_expr E1 (toRTMap (toRExpMap Gamma)) DeltaMapR (toREval (toRExp e)) v__R REAL -> eval_expr E1 (toRTMap (toRExpMap Gamma)) DeltaMapR (toREval (toRExp e)) v__R REAL ->
eval_expr E2 (toRExpMap Gamma) DeltaMap (toRExp e) v__FP m -> 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) validErrorBoundsCmdRec k (updEnv x v__R E1) (updEnv x v__FP E2) A Gamma DeltaMap)
| Ret e => validErrorBounds e E1 E2 A Gamma DeltaMap | Ret e => validErrorBoundsRec e E1 E2 A Gamma DeltaMap
end /\ end /\
forall v__R (iv: intv) (err: error), forall v__R (iv: intv) (err: error),
bstep (toREvalCmd (toRCmd c)) E1 (toRTMap (toRExpMap Gamma)) DeltaMapR v__R REAL -> 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 := ...@@ -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 -> bstep (toRCmd c) E2 (toRExpMap Gamma) DeltaMap v__FP m__FP ->
(Rabs (v__R - v__FP) <= (Q2R err))%R). (Rabs (v__R - v__FP) <= (Q2R err))%R).
Lemma validErrorBoundsCmd_single c E1 E2 A Gamma DeltaMap: Definition validErrorBoundsCmd (c: cmd Q) E1 E2 A Gamma: Prop :=
validErrorBoundsCmd c E1 E2 A Gamma DeltaMap -> 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), forall v__R (iv: intv) (err: error),
bstep (toREvalCmd (toRCmd c)) E1 (toRTMap (toRExpMap Gamma)) DeltaMapR v__R REAL -> bstep (toREvalCmd (toRCmd c)) E1 (toRTMap (toRExpMap Gamma)) DeltaMapR v__R REAL ->
FloverMap.find (getRetExp c) A = Some (iv, err) -> FloverMap.find (getRetExp c) A = Some (iv, err) ->
...@@ -78,5 +90,5 @@ Lemma validErrorBoundsCmd_single c E1 E2 A Gamma DeltaMap: ...@@ -78,5 +90,5 @@ Lemma validErrorBoundsCmd_single c E1 E2 A Gamma DeltaMap:
Proof. Proof.
intros validError_e; intros validError_e;
intros; destruct c; cbn in *; split; intros; destruct c; cbn in *; split;
destruct validError_e as (? & ? & ?); eauto. edestruct validError_e as (? & ? & ?); eauto.
Qed. Qed.
...@@ -43,8 +43,8 @@ Lemma add_abs_err_bounded (e1:expr Q) (e1R:R) (e1F:R) (e2:expr Q) (e2R:R) (e2F:R ...@@ -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)) eval_expr (updEnv 2 e2F (updEnv 1 e1F emptyEnv))
(updDefVars (Binop Plus (Var R 1) (Var R 2)) m (updDefVars (Binop Plus (Var R 1) (Var R 2)) m
(updDefVars (Var R 2) m2 (updDefVars (Var R 1) m1 defVars))) (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)) (fun x _ => if Req_dec_sum x (evalBinop Plus e1F e2F)
then DeltaMap (Binop Plus (toRExp e1) (toRExp e2)) m then DeltaMap (evalBinop Plus e1F e2F) m
else None) else None)
(Binop Plus (Var R 1) (Var R 2)) vF m -> (Binop Plus (Var R 1) (Var R 2)) vF m ->
(Rabs (e1R - e1F) <= Q2R err1)%R -> (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) ...@@ -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)) eval_expr (updEnv 2 e2F (updEnv 1 e1F emptyEnv))
(updDefVars (Binop Sub (Var R 1) (Var R 2)) m (updDefVars (Binop Sub (Var R 1) (Var R 2)) m
(updDefVars (Var R 2) m2 (updDefVars (Var R 1) m1 defVars))) (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)) (fun x _ => if Req_dec_sum x (evalBinop Sub e1F e2F)
then DeltaMap (Binop Sub (toRExp e1) (toRExp e2)) m then DeltaMap (evalBinop Sub e1F e2F) m
else None) else None)
(Binop Sub (Var R 1) (Var R 2)) vF m -> (Binop Sub (Var R 1) (Var R 2)) vF m ->
(Rabs (e1R - e1F) <= Q2R err1)%R -> (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: ...@@ -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)) eval_expr (updEnv 2 e2F (updEnv 1 e1F emptyEnv))
(updDefVars (Binop Mult (Var R 1) (Var R 2)) m (updDefVars (Binop Mult (Var R 1) (Var R 2)) m
(updDefVars (Var R 2) m2 (updDefVars (Var R 1) m1 defVars))) (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)) (fun x _ => if Req_dec_sum x (evalBinop Mult e1F e2F)
then DeltaMap (Binop Mult (toRExp e1) (toRExp e2)) m then DeltaMap (evalBinop Mult e1F e2F) m
else None) else None)
(Binop Mult (Var R 1) (Var R 2)) vF m -> (Binop Mult (Var R 1) (Var R 2)) vF m ->
(Rabs (vR - vF) <= Rabs (e1R * e2R - e1F * e2F) + computeErrorR (e1F * e2F) m)%R. (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 ...@@ -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)) eval_expr (updEnv 2 e2F (updEnv 1 e1F emptyEnv))
(updDefVars (Binop Div (Var R 1) (Var R 2)) m (updDefVars (Binop Div (Var R 1) (Var R 2)) m
(updDefVars (Var R 2) m2 (updDefVars (Var R 1) m1 defVars))) (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)) (fun x _ => if Req_dec_sum x (evalBinop Div e1F e2F)
then DeltaMap (Binop Div (toRExp e1) (toRExp e2)) m then DeltaMap (evalBinop Div e1F e2F) m
else None) else None)
(Binop Div (Var R 1) (Var R 2)) vF m -> (Binop Div (Var R 1) (Var R 2)) vF m ->
(Rabs (vR - vF) <= Rabs (e1R / e2R - e1F / e2F) + computeErrorR (e1F / e2F) m)%R. (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 ...@@ -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 (Fma (Var R 1) (Var R 2) (Var R 3)) m
(updDefVars (Var R 3) m3 (updDefVars (Var R 3) m3
(updDefVars (Var R 2) m2 (updDefVars (Var R 1) m1 defVars)))) (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)) (fun x _ => if Req_dec_sum x (evalFma e1F e2F e3F)
then DeltaMap (Fma (toRExp e1) (toRExp e2) (toRExp e3)) m then DeltaMap (evalFma e1F e2F e3F) m
else None) else None)
(Fma (Var R 1) (Var R 2) (Var R 3)) vF m -> (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. (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) ...@@ -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) eval_expr (updEnv 1 nF1 emptyEnv)
(updDefVars (Downcast mEps (Var R 1)) mEps (updDefVars (Downcast mEps (Var R 1)) mEps
(updDefVars (Var R 1) m defVars)) (updDefVars (Var R 1) m defVars))
(fun x _ => if R_orderedExps.eq_dec x (Downcast mEps (Var R 1)) (fun x _ => if Req_dec_sum x nF1
then DeltaMap (Downcast mEps e) mEps then DeltaMap nF1 mEps
else None) else None)
(toRExp (Downcast mEps (Var Q 1))) nF mEps-> (toRExp (Downcast mEps (Var Q 1))) nF mEps->
(Rabs (nR - nF1) <= err)%R -> (Rabs (nR - nF1) <= err)%R ->
......
This diff is collapsed.
This diff is collapsed.
...@@ -34,16 +34,16 @@ Open Scope R_scope. ...@@ -34,16 +34,16 @@ Open Scope R_scope.
Inductive eval_expr (E:env) Inductive eval_expr (E:env)
(Gamma: expr R -> option mType) (Gamma: expr R -> option mType)
(DeltaMap: expr R -> mType -> option R) (DeltaMap: R -> mType -> option R)
:(expr R) -> R -> mType -> Prop := :(expr R) -> R -> mType -> Prop :=
| Var_load m x v: | Var_load m x v:
Gamma (Var R x) = Some m -> Gamma (Var R x) = Some m ->
E x = Some v -> E x = Some v ->
eval_expr E Gamma DeltaMap (Var R x) v m eval_expr E Gamma DeltaMap (Var R x) v m
| Const_dist m n delta: | Const_dist m c delta:
DeltaMap (Const m n) m = Some delta -> DeltaMap c m = Some delta ->
Rabs delta <= mTypeToR m -> 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: | Unop_neg m mN f1 v1:
Gamma (Unop Neg f1) = Some mN -> Gamma (Unop Neg f1) = Some mN ->
isCompat m mN = true -> isCompat m mN = true ->
...@@ -51,7 +51,7 @@ Inductive eval_expr (E:env) ...@@ -51,7 +51,7 @@ Inductive eval_expr (E:env)
eval_expr E Gamma DeltaMap (Unop Neg f1) (evalUnop Neg v1) mN eval_expr E Gamma DeltaMap (Unop Neg f1) (evalUnop Neg v1) mN
| Unop_inv m mN f1 v1 delta: | Unop_inv m mN f1 v1 delta:
Gamma (Unop Inv f1) = Some mN -> Gamma (Unop Inv f1) = Some mN ->
DeltaMap (Unop Inv f1) mN = Some delta -> DeltaMap (evalUnop Inv v1) mN = Some delta ->
isCompat m mN = true -> isCompat m mN = true ->
Rabs delta <= mTypeToR mN -> Rabs delta <= mTypeToR mN ->
eval_expr E Gamma DeltaMap f1 v1 m -> eval_expr E Gamma DeltaMap f1 v1 m ->
...@@ -59,14 +59,14 @@ Inductive eval_expr (E:env) ...@@ -59,14 +59,14 @@ Inductive eval_expr (E:env)
eval_expr E Gamma DeltaMap (Unop Inv f1) (perturb (evalUnop Inv v1) mN delta) mN eval_expr E Gamma DeltaMap (Unop Inv f1) (perturb (evalUnop Inv v1) mN delta) mN
| Downcast_dist m m1 f1 v1 delta: | Downcast_dist m m1 f1 v1 delta:
Gamma (Downcast m f1) = Some m -> Gamma (Downcast m f1) = Some m ->
DeltaMap (Downcast m f1) m = Some delta -> DeltaMap v1 m = Some delta ->
isMorePrecise m1 m = true -> isMorePrecise m1 m = true ->
Rabs delta <= mTypeToR m -> Rabs delta <= mTypeToR m ->
eval_expr E Gamma DeltaMap f1 v1 m1 -> eval_expr E Gamma DeltaMap f1 v1 m1 ->
eval_expr E Gamma DeltaMap (Downcast m f1) (perturb v1 m delta) m eval_expr E Gamma DeltaMap (Downcast m f1) (perturb v1 m delta) m
| Binop_dist m1 m2 op f1 f2 v1 v2 delta m: | Binop_dist m1 m2 op f1 f2 v1 v2 delta m:
Gamma (Binop op f1 f2) = Some 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 -> isJoin m1 m2 m = true ->
Rabs delta <= mTypeToR m -> Rabs delta <= mTypeToR m ->
eval_expr E Gamma DeltaMap f1 v1 m1 -> eval_expr E Gamma DeltaMap f1 v1 m1 ->
...@@ -75,7 +75,7 @@ Inductive eval_expr (E:env) ...@@ -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 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: | Fma_dist m1 m2 m3 m f1 f2 f3 v1 v2 v3 delta:
Gamma (Fma f1 f2 f3) = Some m -> 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 -> isJoin3 m1 m2 m3 m = true ->
Rabs delta <= mTypeToR m -> Rabs delta <= mTypeToR m ->
eval_expr E Gamma DeltaMap f1 v1 m1 -> eval_expr E Gamma DeltaMap f1 v1 m1 ->
...@@ -83,7 +83,7 @@ Inductive eval_expr (E:env) ...@@ -83,7 +83,7 @@ Inductive eval_expr (E:env)
eval_expr E Gamma DeltaMap f3 v3 m3 -> 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. 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. Close Scope R_scope.
...@@ -92,12 +92,12 @@ Hint Constructors eval_expr. ...@@ -92,12 +92,12 @@ Hint Constructors eval_expr.
(** *) (** *)
(* Show some simpler (more general) rule lemmata *) (* 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') -> Rle (Rabs delta) (mTypeToR m') ->
DeltaMap (Const m n) m = Some delta -> DeltaMap c m = Some delta ->
v = perturb n m delta -> v = perturb c m delta ->
m' = m -> m' = m ->
eval_expr E Gamma DeltaMap (Const m n) v m'. eval_expr E Gamma DeltaMap (Const m c) v m'.
Proof. Proof.
intros; subst; auto. intros; subst; auto.
Qed. Qed.
...@@ -120,7 +120,7 @@ Hint Resolve Unop_neg'. ...@@ -120,7 +120,7 @@ Hint Resolve Unop_neg'.
Lemma Unop_inv' DeltaMap m mN f1 v1 delta v m' E Gamma: Lemma Unop_inv' DeltaMap m mN f1 v1 delta v m' E Gamma:
Rle (Rabs delta) (mTypeToR m') -> Rle (Rabs delta) (mTypeToR m') ->
eval_expr E Gamma DeltaMap f1 v1 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 -> (~ v1 = 0)%R ->
v = perturb (evalUnop Inv v1) mN delta -> v = perturb (evalUnop Inv v1) mN delta ->
Gamma (Unop Inv f1) = Some mN -> Gamma (Unop Inv f1) = Some mN ->
...@@ -137,7 +137,7 @@ Lemma Downcast_dist' DeltaMap m m1 f1 v1 delta v m' E Gamma: ...@@ -137,7 +137,7 @@ Lemma Downcast_dist' DeltaMap m m1 f1 v1 delta v m' E Gamma:
isMorePrecise m1 m = true -> isMorePrecise m1 m = true ->
Rle (Rabs delta) (mTypeToR m') -> Rle (Rabs delta) (mTypeToR m') ->
eval_expr E Gamma DeltaMap f1 v1 m1 -> 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) -> v = (perturb v1 m delta) ->
Gamma (Downcast m f1) = Some m -> Gamma (Downcast m f1) = Some m ->
m' = m -> m' = m ->
...@@ -152,7 +152,7 @@ Lemma Binop_dist' DeltaMap m1 m2 op f1 f2 v1 v2 delta v m m' E Gamma: ...@@ -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') -> Rle (Rabs delta) (mTypeToR m') ->
eval_expr E Gamma DeltaMap f1 v1 m1 -> eval_expr E Gamma DeltaMap f1 v1 m1 ->
eval_expr E Gamma DeltaMap f2 v2 m2 -> 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) -> ((op = Div) -> (~ v2 = 0)%R) ->
v = perturb (evalBinop op v1 v2) m' delta -> v = perturb (evalBinop op v1 v2) m' delta ->
Gamma (Binop op f1 f2) = Some m -> 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: ...@@ -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 f1 v1 m1 ->
eval_expr E Gamma DeltaMap f2 v2 m2 -> eval_expr E Gamma DeltaMap f2 v2 m2 ->
eval_expr E Gamma DeltaMap f3 v3 m3 -> 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 -> v = perturb (evalFma v1 v2 v3) m' delta ->
Gamma (Fma f1 f2 f3) = Some m -> Gamma (Fma f1 f2 f3) = Some m ->
isJoin3 m1 m2 m3 m = true -> isJoin3 m1 m2 m3 m = true ->
...@@ -293,15 +293,15 @@ variables in the Environment. ...@@ -293,15 +293,15 @@ variables in the Environment.
Lemma binary_unfolding b f1 f2 E v1 v2 m1 m2 m Gamma DeltaMap delta: Lemma binary_unfolding b f1 f2 E v1 v2 m1 m2 m Gamma DeltaMap delta:
(b = Div -> ~(v2 = 0 )%R) -> (b = Div -> ~(v2 = 0 )%R) ->
(Rabs delta <= mTypeToR m)%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 f1 v1 m1 ->
eval_expr E Gamma DeltaMap f2 v2 m2 -> 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 E Gamma DeltaMap (Binop b f1 f2) (perturb (evalBinop b v1 v2) m delta) m ->
eval_expr (updEnv 2 v2 (updEnv 1 v1 emptyEnv)) eval_expr (updEnv 2 v2 (updEnv 1 v1 emptyEnv))
(updDefVars (Binop b (Var R 1) (Var R 2)) m (updDefVars (Binop b (Var R 1) (Var R 2)) m
(updDefVars (Var R 2) m2 (updDefVars (Var R 1) m1 Gamma))) (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)) (fun x _ => if Req_dec_sum x (evalBinop b v1 v2)
then DeltaMap (Binop b f1 f2) m then DeltaMap (evalBinop b v1 v2) m
else None) else None)
(Binop b (Var R 1) (Var R 2)) (perturb (evalBinop b v1 v2) m delta) m. (Binop b (Var R 1) (Var R 2)) (perturb (evalBinop b v1 v2) m delta) m.
Proof. Proof.
...@@ -319,15 +319,15 @@ Proof. ...@@ -319,15 +319,15 @@ Proof.
eapply Binop_dist' with (v1:=v1) (v2:=v2) (delta:=delta); try eauto. eapply Binop_dist' with (v1:=v1) (v2:=v2) (delta:=delta); try eauto.
- eapply Var_load; eauto. - eapply Var_load; eauto.
- eapply Var_load; eauto. - eapply Var_load; eauto.
- destruct R_orderedExps.eq_dec as [?|H]; auto. - destruct Req_dec_sum as [?|H]; auto.
exfalso; apply H; apply R_orderedExps.eq_refl. exfalso; now apply H.
- unfold updDefVars. - unfold updDefVars.
unfold R_orderedExps.compare; rewrite R_orderedExps.exprCompare_refl; auto. unfold R_orderedExps.compare; rewrite R_orderedExps.exprCompare_refl; auto.
Qed. Qed.
Lemma fma_unfolding f1 f2 f3 E v1 v2 v3 m1 m2 m3 m Gamma DeltaMap delta: Lemma fma_unfolding f1 f2 f3 E v1 v2 v3 m1 m2 m3 m Gamma DeltaMap delta:
(Rabs delta <= mTypeToR m)%R -> (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 f1 v1 m1 ->
eval_expr E Gamma DeltaMap f2 v2 m2 -> eval_expr E Gamma DeltaMap f2 v2 m2 ->
eval_expr E Gamma DeltaMap f3 v3 m3 -> 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: ...@@ -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 (Fma (Var R 1) (Var R 2) (Var R 3) ) m
(updDefVars (Var R 3) m3 (updDefVars (Var R 2) m2 (updDefVars (Var R 3) m3 (updDefVars (Var R 2) m2
(updDefVars (Var R 1) m1 Gamma)))) (updDefVars (Var R 1) m1 Gamma))))
(fun x _ => if R_orderedExps.eq_dec x (Fma (Var R 1) (Var R 2) (Var R 3)) (fun x _ => if Req_dec_sum x (evalFma v1 v2 v3)
then DeltaMap (Fma f1 f2 f3) m then DeltaMap (evalFma v1 v2 v3) m
else None) else None)
(Fma (Var R 1) (Var R 2) (Var R 3)) (perturb (evalFma v1 v2 v3) m delta) m. (Fma (Var R 1) (Var R 2) (Var R 3)) (perturb (evalFma v1 v2 v3) m delta) m.
Proof. Proof.
...@@ -357,7 +357,9 @@ Proof. ...@@ -357,7 +357,9 @@ Proof.
- eapply Var_load; eauto. - eapply Var_load; eauto.
- eapply Var_load; eauto. - 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. Qed.
Lemma eval_eq_env e: Lemma eval_eq_env e:
...@@ -476,21 +478,29 @@ Proof. ...@@ -476,21 +478,29 @@ Proof.
- destruct u; inversion Heval1; inversion Heval2; subst. - destruct u; inversion Heval1; inversion Heval2; subst.
+ f_equal; eapply IHe; eauto. + f_equal; eapply IHe; eauto.
erewrite Gamma_det; eauto. erewrite Gamma_det; eauto.
+ replace delta with delta0 by congruence. + replace m0 with m in * by (eapply Gamma_det; eauto).
f_equal; f_equal; eapply IHe; eauto. replace v3 with v0 in * by (eapply IHe; eauto).
erewrite Gamma_det; eauto. replace delta with delta0 by congruence.
reflexivity.
- inversion Heval1; inversion Heval2; subst. - inversion Heval1; inversion Heval2; subst.
replace delta with delta0 by congruence. replace m1 with m0 in * by (eapply Gamma_det; eauto).
f_equal; f_equal; [eapply IHe1 | eapply IHe2]; eauto; replace m3 with m2 in * by (eapply Gamma_det; eauto).
erewrite 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. - inversion Heval1; inversion Heval2; subst.
replace delta with delta0 by congruence. replace m1 with m0 in * by (eapply Gamma_det; eauto).