Skip to content

GitLab

Commit cb7a06d9 authored by Heiko Becker's avatar Heiko Becker
Browse files

Merge wit Raphaels mixed precision implementation

parents 824b0b4c ff46cf25
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 2748 additions and 1498 deletions
.gitignore
View file @ cb7a06d9
......@@ -33,15 +33,15 @@ hol4/*/*Theory*
hol4/*/*.ui
hol4/*/*.uo
hol4/*/.*
hol4/heap
hol4/*/heap
hol4/heap
hol4/output/*.sml
hol4/binary/cake_checker
hol4/binary/checker.S
hol4/output/certificate_*
daisy
rawdata/*
.ensime*
/daisy
last.log
output/*
coq/CertificateChecker.v
View file @ cb7a06d9
......@@ -6,15 +6,17 @@
**)
Require Import Coq.Reals.Reals Coq.QArith.Qreals.
Require Import Daisy.Infra.RealSimps Daisy.Infra.RationalSimps Daisy.Infra.RealRationalProps Daisy.Infra.Ltacs.
Require Import Daisy.IntervalValidation Daisy.ErrorValidation Daisy.Environments.
Require Import Daisy.IntervalValidation Daisy.ErrorValidation Daisy.Environments Daisy.Typing.
Require Export Coq.QArith.QArith.
Require Export Daisy.Infra.ExpressionAbbrevs Daisy.Commands.
(** Certificate checking function **)
Definition CertificateChecker (e:exp Q) (absenv:analysisResult) (P:precond) :=
if (validIntervalbounds e absenv P NatSet.empty)
then (validErrorbound e absenv NatSet.empty)
Definition CertificateChecker (e:exp Q) (absenv:analysisResult) (P:precond) (defVars:nat -> option mType) :=
if (typeCheck e defVars (typeMap defVars e)) then
if (validIntervalbounds e absenv P NatSet.empty)
then (validErrorbound e (typeMap defVars e) absenv NatSet.empty)
else false
else false.
(**
......@@ -22,24 +24,23 @@ Definition CertificateChecker (e:exp Q) (absenv:analysisResult) (P:precond) :=
Apart from assuming two executions, one in R and one on floats, we assume that
the real valued execution respects the precondition.
**)
Theorem Certificate_checking_is_sound (e:exp Q) (absenv:analysisResult) P:
forall (E1 E2:env) (vR:R) (vF:R) fVars,
approxEnv E1 absenv fVars NatSet.empty E2 ->
Theorem Certificate_checking_is_sound (e:exp Q) (absenv:analysisResult) P defVars:
forall (E1 E2:env) (vR:R) (vF:R) fVars m,
approxEnv E1 defVars absenv fVars NatSet.empty E2 ->
(forall v, NatSet.mem v fVars = true ->
exists vR, E1 v = Some vR /\
(Q2R (fst (P v)) <= vR <= Q2R (snd (P v)))%R) ->
NatSet.Subset (usedVars e) fVars ->
eval_exp 0%R E1 (toRExp e) vR ->
eval_exp (Q2R machineEpsilon) E2 (toRExp e) vF ->
CertificateChecker e absenv P = true ->
NatSet.Subset (Expressions.usedVars e) fVars ->
eval_exp E1 (toREvalVars defVars) (toREval (toRExp e)) vR M0 ->
eval_exp E2 defVars (toRExp e) vF m ->
CertificateChecker e absenv P defVars = true ->
(Rabs (vR - vF) <= Q2R (snd (absenv e)))%R.
(**
The proofs is a simple composition of the soundness proofs for the range
validator and the error bound validator.
**)
Proof.
intros E1 E2 vR vF fVars approxE1E2 P_valid fVars_subset eval_real eval_float
certificate_valid.
intros * approxE1E2 P_valid fVars_subset eval_real eval_float certificate_valid.
unfold CertificateChecker in certificate_valid.
rewrite <- andb_lazy_alt in certificate_valid.
andb_to_prop certificate_valid.
......@@ -57,58 +58,51 @@ Proof.
inversion v_in_empty.
Qed.
Definition CertificateCheckerCmd (f:cmd Q) (absenv:analysisResult) (P:precond) :=
if (validSSA f (freeVars f))
then
if (validIntervalboundsCmd f absenv P NatSet.empty)
then (validErrorboundCmd f absenv NatSet.empty)
else false
Definition CertificateCheckerCmd (f:cmd Q) (absenv:analysisResult) (P:precond) defVars:=
if (typeCheckCmd f defVars (typeMapCmd defVars f) && validSSA f (freeVars f))
then if (validIntervalboundsCmd f absenv P NatSet.empty)
then (validErrorboundCmd f (typeMapCmd defVars f) absenv NatSet.empty)
else false
else false.
Theorem Certificate_checking_cmds_is_sound (f:cmd Q) (absenv:analysisResult) P:
forall (E1 E2:env) vR vF ,
(* The execution environments are only off by the machine epsilon *)
approxEnv E1 absenv (freeVars f) NatSet.empty E2 ->
(* All free variables are respecting the precondition *)
Theorem Certificate_checking_cmds_is_sound (f:cmd Q) (absenv:analysisResult) P defVars:
forall (E1 E2:env) vR vF m,
approxEnv E1 defVars absenv (freeVars f) NatSet.empty E2 ->
(forall v, NatSet.mem v (freeVars f)= true ->
exists vR, E1 v = Some vR /\
(Q2R (fst (P v)) <= vR <= Q2R (snd (P v)))%R) ->
(* Evaluations on the reals and on 1+delta floats *)
bstep (toRCmd f) E1 0 vR ->
bstep (toRCmd f) E2 (Q2R machineEpsilon) vF ->
(* Certificate checking succeeds *)
CertificateCheckerCmd f absenv P = true ->
(* Thereby we obtain a valid roundoff error *)
bstep (toREvalCmd (toRCmd f)) E1 (toREvalVars defVars) vR M0 ->
bstep (toRCmd f) E2 defVars vF m ->
CertificateCheckerCmd f absenv P defVars = true ->
(Rabs (vR - vF) <= Q2R (snd (absenv (getRetExp f))))%R.
(**
The proofs is a simple composition of the soundness proofs for the range
validator and the error bound validator.
**)
Proof.
intros E1 E2 vR vF approxE1E2 P_valid eval_real eval_float certificate_valid.
intros * approxE1E2 P_valid eval_real eval_float certificate_valid.
unfold CertificateCheckerCmd in certificate_valid.
repeat rewrite <- andb_lazy_alt in certificate_valid.
andb_to_prop certificate_valid.
assert (exists outVars, ssa f (freeVars f) outVars) as ssa_f.
- apply validSSA_sound; auto.
- destruct ssa_f as [outVars ssa_f].
env_assert absenv (getRetExp f) env_f.
destruct env_f as [iv [err absenv_eq]].
destruct iv as [ivlo ivhi].
rewrite absenv_eq; simpl.
eapply (validErrorboundCmd_sound); eauto.
+ instantiate (1 := outVars).
eapply ssa_equal_set; try eauto.
hnf.
intros a; split; intros in_union.
* rewrite NatSet.union_spec in in_union.
destruct in_union as [in_fVars | in_empty]; try auto.
inversion in_empty.
* rewrite NatSet.union_spec; auto.
+ hnf; intros a in_diff.
rewrite NatSet.diff_spec in in_diff.
destruct in_diff; auto.
+ intros v v_in_empty.
rewrite NatSet.mem_spec in v_in_empty.
inversion v_in_empty.
Qed.
apply validSSA_sound in R0.
destruct R0 as [outVars ssa_f].
env_assert absenv (getRetExp f) env_f.
destruct env_f as [iv [err absenv_eq]].
destruct iv as [ivlo ivhi].
rewrite absenv_eq; simpl.
eapply (validErrorboundCmd_sound); eauto.
- instantiate (1 := outVars).
eapply ssa_equal_set; try eauto.
hnf.
intros a; split; intros in_union.
+ rewrite NatSet.union_spec in in_union.
destruct in_union as [in_fVars | in_empty]; try auto.
inversion in_empty.
+ rewrite NatSet.union_spec; auto.
- hnf; intros a in_diff.
rewrite NatSet.diff_spec in in_diff.
destruct in_diff; auto.
- intros v v_in_empty.
rewrite NatSet.mem_spec in v_in_empty.
inversion v_in_empty.
Qed.y
coq/Commands.v
View file @ cb7a06d9
......@@ -2,6 +2,7 @@
Formalization of the Abstract Syntax Tree of a subset used in the Daisy framework
**)
Require Import Coq.Reals.Reals Coq.QArith.QArith.
Require Import Daisy.Expressions.
Require Export Daisy.Infra.ExpressionAbbrevs Daisy.Infra.NatSet.
(**
......@@ -10,21 +11,55 @@ Require Export Daisy.Infra.ExpressionAbbrevs Daisy.Infra.NatSet.
Only assignments and return statement
**)
Inductive cmd (V:Type) :Type :=
Let: nat -> exp V -> cmd V -> cmd V
Let: mType -> nat -> exp V -> cmd V -> cmd V
| Ret: exp V -> cmd V.
Fixpoint getRetExp (V:Type) (f:cmd V) :=
match f with
|Let m x e g => getRetExp g
| Ret e => e
end.
Fixpoint toRCmd (f:cmd Q) :=
match f with
|Let m x e g => Let m x (toRExp e) (toRCmd g)
|Ret e => Ret (toRExp e)
end.
Fixpoint toREvalCmd (f:cmd R) :=
match f with
|Let m x e g => Let M0 x (toREval e) (toREvalCmd g)
|Ret e => Ret (toREval e)
end.
(*
UNUSED!
Small Step semantics for Daisy language
Inductive sstep : cmd R -> env -> R -> cmd R -> env -> Prop :=
let_s x e s E v eps:
eval_exp eps E e v ->
sstep (Let x e s) E eps s (updEnv x v E)
|ret_s e E v eps:
eval_exp eps E e v ->
sstep (Ret e) E eps (Nop R) (updEnv 0 v E).
*)
(**
Define big step semantics for the Daisy language, terminating on a "returned"
result value
**)
Inductive bstep : cmd R -> env -> R -> R -> Prop :=
let_b x e s E v eps res:
eval_exp eps E e v ->
bstep s (updEnv x v E) eps res ->
bstep (Let x e s) E eps res
|ret_b e E v eps:
eval_exp eps E e v ->
bstep (Ret e) E eps v.
Inductive bstep : cmd R -> env -> (nat -> option mType) -> R -> mType -> Prop :=
let_b m m' x e s E v res defVars:
eval_exp E defVars e v m ->
defVars x = Some m ->
bstep s (updEnv x v E) defVars res m' ->
bstep (Let m x e s) E defVars res m'
|ret_b m e E v defVars:
eval_exp E defVars e v m ->
bstep (Ret e) E defVars v m.
(**
The free variables of a command are all used variables of expressions
......@@ -32,8 +67,8 @@ Inductive bstep : cmd R -> env -> R -> R -> Prop :=
**)
Fixpoint freeVars V (f:cmd V) :NatSet.t :=
match f with
| Let x e g => NatSet.remove x (NatSet.union (usedVars e) (freeVars g))
| Ret e => usedVars e
| Let _ x e1 g => NatSet.remove x (NatSet.union (Expressions.usedVars e1) (freeVars g))
| Ret e => Expressions.usedVars e
end.
(**
......@@ -41,7 +76,7 @@ Fixpoint freeVars V (f:cmd V) :NatSet.t :=
**)
Fixpoint definedVars V (f:cmd V) :NatSet.t :=
match f with
| Let x _ g => NatSet.add x (definedVars g)
| Let _ x _ g => NatSet.add x (definedVars g)
| Ret _ => NatSet.empty
end.
......@@ -51,13 +86,6 @@ Fixpoint definedVars V (f:cmd V) :NatSet.t :=
**)
Fixpoint liveVars V (f:cmd V) :NatSet.t :=
match f with
| Let _ e g => NatSet.union (usedVars e) (liveVars g)
| Let _ _ e g => NatSet.union (usedVars e) (liveVars g)
| Ret e => usedVars e
end.
Fixpoint cmdEq f1 f2 :=
match f1, f2 with
|Let x e g, Let y e' g' => expEqBool e e' && (x =? y) && cmdEq g g'
|Ret e, Ret e' => expEqBool e e'
|_, _ => false
end.
\ No newline at end of file
coq/Environments.v
View file @ cb7a06d9
......@@ -12,24 +12,25 @@ It is necessary to have this relation, since two evaluations of the very same
expression may yield different values for different machine epsilons
(or environments that already only approximate each other)
**)
Inductive approxEnv : env -> analysisResult -> NatSet.t -> NatSet.t -> env -> Prop :=
|approxRefl A:
approxEnv emptyEnv A NatSet.empty NatSet.empty emptyEnv
|approxUpdFree E1 E2 A v1 v2 x fVars dVars:
approxEnv E1 A fVars dVars E2 ->
(Rabs (v1 - v2) <= Rabs v1 * Q2R machineEpsilon)%R ->
Inductive approxEnv : env -> (nat -> 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 ->
defVars x = Some m ->
(Rabs (v1 - v2) <= (Rabs v1) * Q2R (meps m))%R ->
NatSet.mem x (NatSet.union fVars dVars) = false ->
approxEnv (updEnv x v1 E1) A (NatSet.add x fVars) dVars (updEnv x v2 E2)
|approxUpdBound E1 E2 A v1 v2 x fVars dVars:
approxEnv E1 A fVars dVars E2 ->
approxEnv (updEnv x v1 E1) defVars A (NatSet.add x fVars) dVars (updEnv x v2 E2)
|approxUpdBound E1 E2 defVars A v1 v2 x fVars dVars:
approxEnv E1 defVars A fVars dVars E2 ->
(Rabs (v1 - v2) <= Q2R (snd (A (Var Q x))))%R ->
NatSet.mem x (NatSet.union fVars dVars) = false ->
approxEnv (updEnv x v1 E1) A fVars (NatSet.add x dVars) (updEnv x v2 E2).
approxEnv (updEnv x v1 E1) defVars A fVars (NatSet.add x dVars) (updEnv x v2 E2).
Inductive approxParams :env -> R -> env -> Prop :=
|approxParamRefl eps:
approxParams emptyEnv eps emptyEnv
|approxParamUpd E1 E2 eps x v1 v2 :
approxParams E1 eps E2 ->
(Rabs (v1 - v2) <= eps)%R ->
approxParams (updEnv x v1 E1) eps (updEnv x v2 E2).
(* Inductive approxParams :env -> env -> Prop := *)
(* |approxParamRefl: *)
(* approxParams emptyEnv emptyEnv *)
(* |approxParamUpd E1 E2 m x v1 v2 : *)
(* approxParams E1 E2 -> *)
(* (Rabs (v1 - v2) <= Q2R (meps m))%R -> *)
(* approxParams (updEnv x M0 v1 E1) (updEnv x m v2 E2). *)
coq/ErrorBounds.v
View file @ cb7a06d9
......@@ -7,10 +7,11 @@ Require Import Coq.Reals.Reals Coq.micromega.Psatz Coq.QArith.QArith Coq.QArith.
Require Import Daisy.Infra.Abbrevs Daisy.Infra.RationalSimps Daisy.Infra.RealSimps Daisy.Infra.RealRationalProps.
Require Import Daisy.Environments Daisy.Infra.ExpressionAbbrevs.
Lemma const_abs_err_bounded (n:R) (nR:R) (nF:R) (E1 E2:env) (absenv:analysisResult):
eval_exp 0%R E1 (Const n) nR ->
eval_exp (Q2R machineEpsilon) E2 (Const n) nF ->
(Rabs (nR - nF) <= Rabs n * (Q2R machineEpsilon))%R.
Lemma const_abs_err_bounded (n:R) (nR:R) (nF:R) (E1 E2:env) (m:mType) defVars:
eval_exp E1 (toREvalVars defVars) (Const M0 n) nR M0 ->
eval_exp E2 defVars (Const m n) nF m ->
(Rabs (nR - nF) <= Rabs n * (Q2R (meps m)))%R.
Proof.
intros eval_real eval_float.
inversion eval_real; subst.
......@@ -19,42 +20,49 @@ Proof.
unfold perturb; simpl.
rewrite Rabs_err_simpl, Rabs_mult.
apply Rmult_le_compat_l; [apply Rabs_pos | auto].
simpl (meps M0) in *.
apply (Rle_trans _ (Q2R 0) _); try auto.
rewrite Q2R0_is_0; lra.
Qed.
Lemma add_abs_err_bounded (e1:exp Q) (e1R:R) (e1F:R) (e2:exp Q) (e2R:R) (e2F:R)
(vR:R) (vF:R) (E1 E2:env) (err1 err2 :Q):
eval_exp 0%R E1 (toRExp e1) e1R ->
eval_exp (Q2R machineEpsilon) E2 (toRExp e1) e1F ->
eval_exp 0%R E1 (toRExp e2) e2R ->
eval_exp (Q2R machineEpsilon) E2 (toRExp e2) e2F ->
eval_exp 0%R E1 (Binop Plus (toRExp e1) (toRExp e2)) vR ->
eval_exp (Q2R machineEpsilon) (updEnv 2 e2F (updEnv 1 e1F emptyEnv)) (Binop Plus (Var R 1) (Var R 2)) vF ->
(vR:R) (vF:R) (E1 E2:env) (err1 err2 :Q) (m m1 m2:mType) defVars:
eval_exp E1 (toREvalVars defVars) (toREval (toRExp e1)) e1R M0 ->
eval_exp E2 defVars (toRExp e1) e1F m1->
eval_exp E1 (toREvalVars defVars) (toREval (toRExp e2)) e2R M0 ->
eval_exp E2 defVars (toRExp e2) e2F m2 ->
eval_exp E1 (toREvalVars defVars) (toREval (Binop Plus (toRExp e1) (toRExp e2))) vR M0 ->
eval_exp (updEnv 2 e2F (updEnv 1 e1F emptyEnv))
(updDefVars 2 m2 (updDefVars 1 m1 defVars))
(Binop Plus (Var R 1) (Var R 2)) vF m ->
(Rabs (e1R - e1F) <= Q2R err1)%R ->
(Rabs (e2R - e2F) <= Q2R err2)%R ->
(Rabs (vR - vF) <= Q2R err1 + Q2R err2 + (Rabs (e1F + e2F) * (Q2R machineEpsilon)))%R.
(Rabs (vR - vF) <= Q2R err1 + Q2R err2 + (Rabs (e1F + e2F) * (Q2R (meps m))))%R.
Proof.
intros e1_real e1_float e2_real e2_float plus_real plus_float bound_e1 bound_e2.
(* Prove that e1R and e2R are the correct values and that vR is e1R + e2R *)
inversion plus_real; subst.
destruct m0; destruct m3; inversion H2;
simpl in H3; rewrite Q2R0_is_0 in H3; auto.
rewrite delta_0_deterministic in plus_real; auto.
rewrite (delta_0_deterministic (evalBinop Plus v1 v2) delta); auto.
unfold evalBinop in *; simpl in *.
clear delta H2.
rewrite (meps_0_deterministic H3 e1_real);
rewrite (meps_0_deterministic H5 e2_real).
rewrite (meps_0_deterministic H3 e1_real) in plus_real.
rewrite (meps_0_deterministic H5 e2_real) in plus_real.
clear H3 H5 H6 v1 v2.
clear delta H3.
rewrite (meps_0_deterministic (toRExp e1) H5 e1_real);
rewrite (meps_0_deterministic (toRExp e2) H6 e2_real).
rewrite (meps_0_deterministic (toRExp e1) H5 e1_real) in plus_real.
rewrite (meps_0_deterministic (toRExp e2) H6 e2_real) in plus_real.
clear H5 H6 H7 v1 v2.
(* Now unfold the float valued evaluation to get the deltas we need for the inequality *)
inversion plus_float; subst.
unfold perturb; simpl.
inversion H3; subst; inversion H5; subst.
inversion H4; subst; inversion H7; subst.
unfold updEnv; simpl.
unfold updEnv in H0,H1; simpl in *.
symmetry in H0, H1.
inversion H0; inversion H1; subst.
unfold updEnv in H1,H6; simpl in *.
symmetry in H1,H6.
inversion H1; inversion H6; subst.
(* We have now obtained all necessary values from the evaluations --> remove them for readability *)
clear plus_float H3 H5 plus_real e1_real e1_float e2_real e2_float H0 H1.
clear plus_float H4 H7 plus_real e1_real e1_float e2_real e2_float H8 H6 H1.
repeat rewrite Rmult_plus_distr_l.
rewrite Rmult_1_r.
rewrite Rsub_eq_Ropp_Rplus.
......@@ -65,9 +73,9 @@ Proof.
eapply Rle_trans.
apply H.
pose proof (Rabs_triang (e2R + - e2F) (- ((e1F + e2F) * delta))).
pose proof (Rplus_le_compat_l (Rabs (e1R + - e1F)) _ _ H0).
pose proof (Rplus_le_compat_l (Rabs (e1R + - e1F)) _ _ H1).
eapply Rle_trans.
apply H1.
apply H4.
rewrite <- Rplus_assoc.
repeat rewrite <- Rsub_eq_Ropp_Rplus.
rewrite Rabs_Ropp.
......@@ -77,7 +85,7 @@ Proof.
eapply Rle_trans.
eapply Rmult_le_compat_l.
apply Rabs_pos.
apply H2.
apply H3.
apply Req_le; auto.
Qed.
......@@ -85,39 +93,44 @@ Qed.
Copy-Paste proof with minor differences, was easier then manipulating the evaluations and then applying the lemma
**)
Lemma subtract_abs_err_bounded (e1:exp Q) (e1R:R) (e1F:R) (e2:exp Q) (e2R:R)
(e2F:R) (vR:R) (vF:R) (E1 E2:env) err1 err2:
eval_exp 0%R E1 (toRExp e1) e1R ->
eval_exp (Q2R machineEpsilon) E2 (toRExp e1) e1F ->
eval_exp 0%R E1 (toRExp e2) e2R ->
eval_exp (Q2R machineEpsilon) E2 (toRExp e2) e2F ->
eval_exp 0%R E1 (Binop Sub (toRExp e1) (toRExp e2)) vR ->
eval_exp (Q2R machineEpsilon) (updEnv 2 e2F (updEnv 1 e1F emptyEnv)) (Binop Sub (Var R 1) (Var R 2)) vF ->
(e2F:R) (vR:R) (vF:R) (E1 E2:env) err1 err2 (m m1 m2:mType) defVars:
eval_exp E1 (toREvalVars defVars) (toREval (toRExp e1)) e1R M0 ->
eval_exp E2 defVars (toRExp e1) e1F m1 ->
eval_exp E1 (toREvalVars defVars) (toREval (toRExp e2)) e2R M0 ->
eval_exp E2 defVars (toRExp e2) e2F m2 ->
eval_exp E1 (toREvalVars defVars) (toREval (Binop Sub (toRExp e1) (toRExp e2))) vR M0 ->
eval_exp (updEnv 2 e2F (updEnv 1 e1F emptyEnv))
(updDefVars 2 m2 (updDefVars 1 m1 defVars))
(Binop Sub (Var R 1) (Var R 2)) vF m ->
(Rabs (e1R - e1F) <= Q2R err1)%R ->
(Rabs (e2R - e2F) <= Q2R err2)%R ->
(Rabs (vR - vF) <= Q2R err1 + Q2R err2 + ((Rabs (e1F - e2F)) * (Q2R machineEpsilon)))%R.
(Rabs (vR - vF) <= Q2R err1 + Q2R err2 + ((Rabs (e1F - e2F)) * (Q2R (meps m))))%R.
Proof.
intros e1_real e1_float e2_real e2_float sub_real sub_float bound_e1 bound_e2.
(* Prove that e1R and e2R are the correct values and that vR is e1R + e2R *)
inversion sub_real; subst.
inversion sub_real; subst;
destruct m0; destruct m3; inversion H2;
simpl in H3; rewrite Q2R0_is_0 in H3; auto.
rewrite delta_0_deterministic in sub_real; auto.
rewrite delta_0_deterministic; auto.
unfold evalBinop in *; simpl in *.
clear delta H2.
rewrite (meps_0_deterministic H3 e1_real);
rewrite (meps_0_deterministic H5 e2_real).
rewrite (meps_0_deterministic H3 e1_real) in sub_real.
rewrite (meps_0_deterministic H5 e2_real) in sub_real.
clear H3 H5 H6 v1 v2.
clear delta H3.
rewrite (meps_0_deterministic (toRExp e1) H5 e1_real);
rewrite (meps_0_deterministic (toRExp e2) H6 e2_real).
rewrite (meps_0_deterministic (toRExp e1) H5 e1_real) in sub_real.
rewrite (meps_0_deterministic (toRExp e2) H6 e2_real) in sub_real.
clear H5 H6 H7 v1 v2.
(* Now unfold the float valued evaluation to get the deltas we need for the inequality *)
inversion sub_float; subst.
unfold perturb; simpl.
inversion H3; subst; inversion H5; subst.
inversion H4; subst; inversion H7; subst.
unfold updEnv; simpl.
symmetry in H0, H1.
unfold updEnv in H0, H1; simpl in H0, H1.
inversion H0; inversion H1; subst.
simpl in H0; simpl in H5; inversion H0; inversion H5; subst; clear H0 H5.
symmetry in H6, H1.
unfold updEnv in H6, H1; simpl in H6, H1.
inversion H6; inversion H1; subst.
(* We have now obtained all necessary values from the evaluations --> remove them for readability *)
clear sub_float H3 H5 sub_real e1_real e1_float e2_real e2_float H0 H1.
clear sub_float H4 H7 sub_real e1_real e1_float e2_real e2_float H8 H1 H6.
repeat rewrite Rmult_plus_distr_l.
rewrite Rmult_1_r.
repeat rewrite Rsub_eq_Ropp_Rplus.
......@@ -141,36 +154,40 @@ Proof.
Qed.
Lemma mult_abs_err_bounded (e1:exp Q) (e1R:R) (e1F:R) (e2:exp Q) (e2R:R) (e2F:R)
(vR:R) (vF:R) (E1 E2:env):
eval_exp 0%R E1 (toRExp e1) e1R ->
eval_exp (Q2R machineEpsilon) E2 (toRExp e1) e1F ->
eval_exp 0%R E1 (toRExp e2) e2R ->
eval_exp (Q2R machineEpsilon) E2 (toRExp e2) e2F ->
eval_exp 0%R E1 (Binop Mult (toRExp e1) (toRExp e2)) vR ->
eval_exp (Q2R machineEpsilon) (updEnv 2 e2F (updEnv 1 e1F emptyEnv)) (Binop Mult (Var R 1) (Var R 2)) vF ->
(Rabs (vR - vF) <= Rabs (e1R * e2R - e1F * e2F) + Rabs (e1F * e2F) * (Q2R machineEpsilon))%R.
(vR:R) (vF:R) (E1 E2:env) (m m1 m2:mType) defVars:
eval_exp E1 (toREvalVars defVars) (toREval (toRExp e1)) e1R M0 ->
eval_exp E2 defVars (toRExp e1) e1F m1 ->
eval_exp E1 (toREvalVars defVars) (toREval (toRExp e2)) e2R M0 ->
eval_exp E2 defVars (toRExp e2) e2F m2 ->
eval_exp E1 (toREvalVars defVars) (toREval (Binop Mult (toRExp e1) (toRExp e2))) vR M0 ->
eval_exp (updEnv 2 e2F (updEnv 1 e1F emptyEnv))
(updDefVars 2 m2 (updDefVars 1 m1 defVars))
(Binop Mult (Var R 1) (Var R 2)) vF m ->
(Rabs (vR - vF) <= Rabs (e1R * e2R - e1F * e2F) + Rabs (e1F * e2F) * (Q2R (meps m)))%R.
Proof.
intros e1_real e1_float e2_real e2_float mult_real mult_float.
(* Prove that e1R and e2R are the correct values and that vR is e1R * e2R *)
inversion mult_real; subst.
inversion mult_real; subst;
destruct m0; destruct m3; inversion H2;
simpl in H3; rewrite Q2R0_is_0 in H3; auto.
rewrite delta_0_deterministic in mult_real; auto.
rewrite delta_0_deterministic; auto.
unfold evalBinop in *; simpl in *.
clear delta H2.
rewrite (meps_0_deterministic H3 e1_real);
rewrite (meps_0_deterministic H5 e2_real).
rewrite (meps_0_deterministic H3 e1_real) in mult_real.
rewrite (meps_0_deterministic H5 e2_real) in mult_real.
clear H3 H5 H6 v1 v2.
clear delta H3.
rewrite (meps_0_deterministic (toRExp e1) H5 e1_real);
rewrite (meps_0_deterministic (toRExp e2) H6 e2_real).
rewrite (meps_0_deterministic (toRExp e1) H5 e1_real) in mult_real.
rewrite (meps_0_deterministic (toRExp e2) H6 e2_real) in mult_real.
clear H5 H6 v1 v2 H7 H2.
(* Now unfold the float valued evaluation to get the deltas we need for the inequality *)
inversion mult_float; subst.
unfold perturb; simpl.
inversion H3; subst; inversion H5; subst.
symmetry in H0, H1;
inversion H3; subst; inversion H6; subst.
unfold updEnv in *; simpl in *.
inversion H0; inversion H1; subst.
inversion H6; inversion H1; subst.
simpl in H8; simpl in H9; intros; inversion H5; subst.
(* We have now obtained all necessary values from the evaluations --> remove them for readability *)
clear mult_float H3 H5 mult_real e1_real e1_float e2_real e2_float H0 H1.
clear mult_float H7 mult_real e1_real e1_float e2_real e2_float H6 H1.
repeat rewrite Rmult_plus_distr_l.
rewrite Rmult_1_r.
rewrite Rsub_eq_Ropp_Rplus.
......@@ -188,36 +205,39 @@ Proof.
Qed.
Lemma div_abs_err_bounded (e1:exp Q) (e1R:R) (e1F:R) (e2:exp Q) (e2R:R) (e2F:R)
(vR:R) (vF:R) (E1 E2:env):
eval_exp 0%R E1 (toRExp e1) e1R ->
eval_exp (Q2R machineEpsilon) E2 (toRExp e1) e1F ->
eval_exp 0%R E1 (toRExp e2) e2R ->
eval_exp (Q2R machineEpsilon) E2 (toRExp e2) e2F ->
eval_exp 0%R E1 (Binop Div (toRExp e1) (toRExp e2)) vR ->
eval_exp (Q2R machineEpsilon) (updEnv 2 e2F (updEnv 1 e1F emptyEnv)) (Binop Div (Var R 1) (Var R 2)) vF ->
(Rabs (vR - vF) <= Rabs (e1R / e2R - e1F / e2F) + Rabs (e1F / e2F) * (Q2R machineEpsilon))%R.
(vR:R) (vF:R) (E1 E2:env) (m m1 m2:mType) defVars:
eval_exp E1 (toREvalVars defVars) (toREval (toRExp e1)) e1R M0 ->
eval_exp E2 defVars (toRExp e1) e1F m1 ->
eval_exp E1 (toREvalVars defVars) (toREval (toRExp e2)) e2R M0 ->
eval_exp E2 defVars (toRExp e2) e2F m2 ->
eval_exp E1 (toREvalVars defVars) (toREval (Binop Div (toRExp e1) (toRExp e2))) vR M0 ->
eval_exp (updEnv 2 e2F (updEnv 1 e1F emptyEnv))
(updDefVars 2 m2 (updDefVars 1 m1 defVars))
(Binop Div (Var R 1) (Var R 2)) vF m ->
(Rabs (vR - vF) <= Rabs (e1R / e2R - e1F / e2F) + Rabs (e1F / e2F) * (Q2R (meps m)))%R.
Proof.
intros e1_real e1_float e2_real e2_float div_real div_float.
(* Prove that e1R and e2R are the correct values and that vR