Skip to content

GitLab

Commit 42885f73 authored by Heiko Becker's avatar Heiko Becker
Browse files
Options

Draft structure for new type validator/type system, incorporating Fixed-point types properly

parent d78f37ce
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 2058 additions and 1921 deletions
coq/CertificateChecker.v
View file @ 42885f73
......@@ -7,20 +7,21 @@
From Flover
Require Import Infra.RealSimps Infra.RationalSimps Infra.RealRationalProps
Infra.Ltacs RealRangeArith RealRangeValidator RoundoffErrorValidator
Environments Typing FPRangeValidator ExpressionAbbrevs Commands.
Environments TypeValidator FPRangeValidator ExpressionAbbrevs Commands.
Require Export Infra.ExpressionAbbrevs Flover.Commands Coq.QArith.QArith.
Require Export ExpressionSemantics Flover.Commands Coq.QArith.QArith.
(** Certificate checking function **)
Definition CertificateChecker (e:expr Q) (absenv:analysisResult)
(P:precond) (defVars:nat -> option mType) (fBits:FloverMap.t N):=
let tMap := (typeMap defVars e (FloverMap.empty mType) fBits) in
if (typeCheck e defVars tMap fBits)
then
if RangeValidator e absenv P NatSet.empty && FPRangeValidator e absenv tMap NatSet.empty
then RoundoffErrorValidator e tMap absenv NatSet.empty
else false
else false.
(P:precond) (defVars:FloverMap.t mType):=
let tMap := (getValidMap defVars e (FloverMap.empty mType)) in
match tMap with
|Succes tMap =>
if RangeValidator e absenv P NatSet.empty && FPRangeValidator e absenv tMap NatSet.empty
then RoundoffErrorValidator e tMap absenv NatSet.empty
else false
| _ => false
end.
(**
Soundness proof for the certificate checker.
......@@ -28,22 +29,22 @@ Definition CertificateChecker (e:expr Q) (absenv:analysisResult)
the real valued execution respects the precondition.
**)
Theorem Certificate_checking_is_sound (e:expr Q) (absenv:analysisResult) P
defVars fBits:
defVars:
forall (E1 E2:env),
approxEnv E1 defVars absenv (usedVars e) NatSet.empty E2 ->
approxEnv E1 (toRTMap defVars) absenv (usedVars e) NatSet.empty E2 ->
(forall v, NatSet.In v (Expressions.usedVars e) ->
exists vR, E1 v = Some vR /\
(Q2R (fst (P v)) <= vR <= Q2R (snd (P v)))%R) ->
(forall v, NatSet.In v (usedVars e) ->
exists m : mType,
defVars v = Some m) ->
CertificateChecker e absenv P defVars fBits = true ->
exists iv err vR vF m,
FloverMap.find (Var Q v) defVars = Some m) ->
CertificateChecker e absenv P defVars = true ->
exists Gamma iv err vR vF m,
FloverMap.find e absenv = Some (iv, err) /\
eval_expr E1 (toRMap defVars) (toRBMap fBits) (toREval (toRExp e)) vR REAL /\
eval_expr E2 defVars (toRBMap fBits) (toRExp e) vF m /\
eval_expr E1 (toRMap Gamma) (toRExp e) vR REAL /\
eval_expr E2 Gamma (toRExp e) vF m /\
(forall vF m,
eval_expr E2 defVars (toRBMap fBits) (toRExp e) vF m ->
eval_expr E2 Gamma (toRExp e) vF m ->
(Rabs (vR - vF) <= Q2R err))%R.
(**
The proofs is a simple composition of the soundness proofs for the range
......@@ -52,26 +53,25 @@ Theorem Certificate_checking_is_sound (e:expr Q) (absenv:analysisResult) P
Proof.
intros * approxE1E2 P_valid types_defined certificate_valid.
unfold CertificateChecker in certificate_valid.
destruct (getValidMap defVars e (FloverMap.empty mType)); try congruence.
rewrite <- andb_lazy_alt in certificate_valid.
andb_to_prop certificate_valid.
clear R1.
pose proof (NatSetProps.empty_union_2 (Expressions.usedVars e) NatSet.empty_spec) as union_empty.
hnf in union_empty.
assert (dVars_range_valid NatSet.empty E1 absenv).
{ unfold dVars_range_valid.
intros; set_tac. }
assert (affine_dVars_range_valid NatSet.empty E1 absenv 1 (FloverMap.empty _) (fun _ => None))
(* assert (affine_dVars_range_valid NatSet.empty E1 absenv 1 (FloverMap.empty _) (fun _ => None))
as affine_dvars_valid.
{ unfold affine_dVars_range_valid.
intros; set_tac. }
intros; set_tac. } *)
assert (NatSet.Subset (usedVars e -- NatSet.empty) (Expressions.usedVars e)).
{ hnf; intros a in_empty.
set_tac. }
assert (vars_typed (usedVars e ∪ NatSet.empty) defVars).
{ unfold vars_typed. intros; apply types_defined. set_tac. destruct H1; set_tac.
split; try auto. hnf; intros; set_tac. }
rename R into validFPRanges.
assert (validRanges e absenv E1 defVars (toRBMap fBits)) as valid_e.
{ eapply (RangeValidator_sound e (dVars:=NatSet.empty) (A:=absenv) (P:=P) (Gamma:=defVars) (E:=E1));
assert (validRanges e absenv E1 (toRTMap defVars)) as valid_e.
{ eapply (RangeValidator_sound e (dVars:=NatSet.empty) (A:=absenv) (P:=P) (Gamma:=toRTMap defVars) (E:=E1));
auto. }
pose proof (validRanges_single _ _ _ _ _ valid_e) as valid_single;
destruct valid_single as [iv_e [ err_e [vR [ map_e [eval_real real_bounds_e]]]]].
......
coq/Commands.v
View file @ 42885f73
......@@ -2,7 +2,7 @@
Formalization of the Abstract Syntax Tree of a subset used in the Flover framework
**)
Require Import Coq.Reals.Reals Coq.QArith.QArith.
Require Import Flover.Expressions.
Require Export Flover.ExpressionSemantics.
Require Export Flover.Infra.ExpressionAbbrevs Flover.Infra.NatSet.
(**
......@@ -20,7 +20,6 @@ Fixpoint getRetExp (V:Type) (f:cmd V) :=
| Ret e => e
end.
Fixpoint toRCmd (f:cmd Q) :=
match f with
|Let m x e g => Let m x (toRExp e) (toRCmd g)
......@@ -49,14 +48,14 @@ 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 -> (nat -> option mType) -> (expr R -> option N) -> R -> mType -> Prop :=
let_b m m' x e s E v res defVars fBits:
eval_expr E defVars fBits e v m ->
bstep s (updEnv x v E) (updDefVars x m defVars) fBits res m' ->
bstep (Let m x e s) E defVars fBits res m'
|ret_b m e E v defVars fBits:
eval_expr E defVars fBits e v m ->
bstep (Ret e) E defVars fBits v m.
Inductive bstep : cmd R -> env -> (expr R -> option mType) -> R -> mType -> Prop :=
let_b m m' x e s E v res defVars:
eval_expr E defVars e v m ->
bstep s (updEnv x v E) (updDefVars (Var R x) m defVars) res m' ->
bstep (Let m x e s) E defVars res m'
|ret_b m e E v defVars:
eval_expr E defVars e v m ->
bstep (Ret e) E defVars v m.
(**
The free variables of a command are all used variables of exprressions
......@@ -88,14 +87,14 @@ Fixpoint liveVars V (f:cmd V) :NatSet.t :=
end.
Lemma bstep_eq_env f:
forall E1 E2 Gamma fBits v m,
forall E1 E2 Gamma v m,
(forall x, E1 x = E2 x) ->
bstep f E1 Gamma fBits v m ->
bstep f E2 Gamma fBits v m.
bstep f E1 Gamma v m ->
bstep f E2 Gamma v m.
Proof.
induction f; intros * eq_envs bstep_E1;
inversion bstep_E1; subst; simpl in *.
- eapply eval_eq_env in H8; eauto. eapply let_b; eauto.
- eapply eval_eq_env in H7; eauto. eapply let_b; eauto.
eapply IHf. instantiate (1:=(updEnv n v0 E1)).
+ intros; unfold updEnv.
destruct (x=? n); auto.
......
coq/Environments.v
View file @ 42885f73
......@@ -16,7 +16,7 @@ It is necessary to have this relation, since two evaluations of the very same
exprression may yield different values for different machine epsilons
(or environments that already only approximate each other)
**)
Inductive approxEnv : env -> (nat -> option mType) -> analysisResult -> NatSet.t
Inductive approxEnv : env -> (expr R -> option mType) -> analysisResult -> NatSet.t
-> NatSet.t -> env -> Prop :=
|approxRefl defVars A:
approxEnv emptyEnv defVars A NatSet.empty NatSet.empty emptyEnv
......@@ -25,7 +25,7 @@ Inductive approxEnv : env -> (nat -> option mType) -> analysisResult -> NatSet.t
(Rabs (v1 - v2) <= computeErrorR v1 m)%R ->
NatSet.mem x (NatSet.union fVars dVars) = false ->
approxEnv (updEnv x v1 E1)
(updDefVars x m defVars) A (NatSet.add x fVars) dVars
(updDefVars (Var R x) m defVars) A (NatSet.add x fVars) dVars
(updEnv x v2 E2)
|approxUpdBound E1 E2 defVars A v1 v2 x fVars dVars m iv err:
approxEnv E1 defVars A fVars dVars E2 ->
......@@ -33,12 +33,12 @@ Inductive approxEnv : env -> (nat -> option mType) -> analysisResult -> NatSet.t
(Rabs (v1 - v2) <= Q2R err)%R ->
NatSet.mem x (NatSet.union fVars dVars) = false ->
approxEnv (updEnv x v1 E1)
(updDefVars x m defVars) A fVars (NatSet.add x dVars)
(updDefVars (Var R x) m defVars) A fVars (NatSet.add x dVars)
(updEnv x v2 E2).
Section RelationProperties.
Variable (x:nat) (v:R) (E1 E2:env) (Gamma:nat -> option mType)
Variable (x:nat) (v:R) (E1 E2:env) (Gamma:expr R -> option mType)
(A:analysisResult) (fVars dVars: NatSet.t).
Hypothesis approxEnvs: approxEnv E1 Gamma A fVars dVars E2.
......@@ -76,7 +76,7 @@ Section RelationProperties.
E1 x = Some v ->
E2 x = Some v2 ->
NatSet.In x fVars ->
Gamma x = Some m ->
Gamma (Var R x) = Some m ->
(Rabs (v - v2) <= computeErrorR v m)%R.
Proof.
induction approxEnvs;
......@@ -87,30 +87,40 @@ Section RelationProperties.
+ unfold updEnv in *;
rewrite Nat.eqb_refl in *; simpl in *.
unfold updDefVars in x_typed.
rewrite Nat.eqb_refl in x_typed.
cbn in x_typed.
rewrite Nat.compare_refl in x_typed.
inversion x_typed; subst.
inversion E1_def; inversion E2_def; subst; auto.
+ unfold updEnv in *; simpl in *.
rewrite <- Nat.eqb_neq in x_neq.
rewrite x_neq in *; simpl in *.
unfold updDefVars in x_typed; rewrite x_neq in x_typed.
apply IHa; auto.
unfold updDefVars in x_typed.
cbn in x_typed.
apply Nat.eqb_neq in x_neq.
destruct (x ?= x0)%nat eqn:?.
* apply Nat.compare_eq in Heqc; subst; congruence.
* apply IHa; auto.
* apply IHa; auto.
- assert (x =? x0 = false) as x_x0_neq.
{ rewrite Nat.eqb_neq; hnf; intros; subst.
set_tac.
apply H1.
set_tac. }
unfold updEnv in *; rewrite x_x0_neq in *.
apply IHa; auto.
unfold updDefVars in x_typed;
rewrite x_x0_neq in x_typed; auto.
unfold updDefVars in x_typed.
cbn in x_typed.
apply Nat.eqb_neq in x_x0_neq.
destruct (x ?= x0)%nat eqn:?.
* apply Nat.compare_eq in Heqc; subst; congruence.
* apply IHa; auto.
* apply IHa; auto.
Qed.
Lemma approxEnv_dVar_bounded v2 m iv e:
E1 x = Some v ->
E2 x = Some v2 ->
NatSet.In x dVars ->
Gamma x = Some m ->
Gamma (Var R x) = Some m ->
FloverMap.find (Var Q x) A = Some (iv, e) ->
(Rabs (v - v2) <= Q2R e)%R.
Proof.
......@@ -123,8 +133,12 @@ Section RelationProperties.
apply H0; set_tac.
}
unfold updEnv in *; rewrite x_x0_neq in *.
unfold updDefVars in x_typed; rewrite x_x0_neq in x_typed.
apply IHa; auto.
unfold updDefVars in x_typed; cbn in x_typed.
apply Nat.eqb_neq in x_x0_neq.
destruct (x ?= x0)%nat eqn:?.
* apply Nat.compare_eq in Heqc; subst; congruence.
* apply IHa; auto.
* apply IHa; auto.
- set_tac.
destruct x_def as [x_x0 | [x_neq x_def]]; subst.
+ unfold updEnv in *;
......@@ -134,8 +148,12 @@ Section RelationProperties.
+ unfold updEnv in *; simpl in *.
rewrite <- Nat.eqb_neq in x_neq.
rewrite x_neq in *; simpl in *.
unfold updDefVars in x_typed; rewrite x_neq in x_typed.
apply IHa; auto.
unfold updDefVars in x_typed; cbn in x_typed.
apply Nat.eqb_neq in x_neq.
destruct (x ?= x0)%nat eqn:?.
* apply Nat.compare_eq in Heqc; subst; congruence.
* apply IHa; auto.
* apply IHa; auto.
Qed.
End RelationProperties.
\ No newline at end of file
coq/ErrorBounds.v
View file @ 42885f73
......@@ -5,11 +5,11 @@ Bounds are exprlained in section 5, Deriving Computable Error Bounds
**)
Require Import Coq.Reals.Reals Coq.micromega.Psatz Coq.QArith.QArith Coq.QArith.Qreals.
Require Import Flover.Infra.Abbrevs Flover.Infra.RationalSimps Flover.Infra.RealSimps Flover.Infra.RealRationalProps.
Require Import Flover.Environments Flover.Infra.ExpressionAbbrevs.
Require Import Flover.Environments Flover.Infra.ExpressionAbbrevs Flover.ExpressionSemantics.
Lemma const_abs_err_bounded (n:R) (nR:R) (nF:R) (E1 E2:env) (m:mType) defVars fBits:
eval_expr E1 (toRMap defVars) fBits (Const REAL n) nR REAL ->
eval_expr E2 defVars fBits (Const m n) nF m ->
Lemma const_abs_err_bounded (n:R) (nR:R) (nF:R) (E1 E2:env) (m:mType) defVars:
eval_expr E1 (toRMap defVars) (Const REAL n) nR REAL ->
eval_expr E2 defVars (Const m n) nF m ->
(Rabs (nR - nF) <= computeErrorR n m)%R.
Proof.
intros eval_real eval_float.
......@@ -30,19 +30,14 @@ Proof.
Qed.
Lemma add_abs_err_bounded (e1:expr Q) (e1R:R) (e1F:R) (e2:expr Q) (e2R:R) (e2F:R)
(vR:R) (vF:R) (E1 E2:env) (err1 err2 :Q) (m m1 m2:mType) defVars fBits:
eval_expr E1 (toRMap defVars) fBits (toREval (toRExp e1)) e1R REAL ->
eval_expr E2 defVars fBits (toRExp e1) e1F m1->
eval_expr E1 (toRMap defVars) fBits (toREval (toRExp e2)) e2R REAL ->
eval_expr E2 defVars fBits (toRExp e2) e2F m2 ->
eval_expr E1 (toRMap defVars) fBits (toREval (Binop Plus (toRExp e1) (toRExp e2))) vR REAL ->
(vR:R) (vF:R) (E1 E2:env) (err1 err2 :Q) (m m1 m2:mType) defVars:
eval_expr E1 (toRMap defVars) (toREval (toRExp e1)) e1R REAL ->
eval_expr E2 defVars (toRExp e1) e1F m1->
eval_expr E1 (toRMap defVars) (toREval (toRExp e2)) e2R REAL ->
eval_expr E2 defVars (toRExp e2) e2F m2 ->
eval_expr E1 (toRMap defVars) (toREval (Binop Plus (toRExp e1) (toRExp e2))) vR REAL ->
eval_expr (updEnv 2 e2F (updEnv 1 e1F emptyEnv))
(updDefVars 2 m2 (updDefVars 1 m1 defVars))
(fun e =>
match e with
| Binop b (Var _ 1) (Var _ 2) => fBits (toRExp (Binop b e1 e2))
| _ => fBits e
end)
(updDefVars (Var R 2) m2 (updDefVars (Var R 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 ->
......@@ -57,25 +52,24 @@ Proof.
rewrite delta_0_deterministic in plus_real; auto.
rewrite (delta_0_deterministic (evalBinop Plus v1 v2) REAL delta); auto.
unfold evalBinop in *; simpl in *.
clear delta H2.
rewrite (meps_0_deterministic (toRExp e1) H3 e1_real);
rewrite (meps_0_deterministic (toRExp e2) H4 e2_real).
rewrite (meps_0_deterministic (toRExp e1) H3 e1_real) in plus_real.
rewrite (meps_0_deterministic (toRExp e2) H4 e2_real) in plus_real.
rewrite (meps_0_deterministic (toRExp e1) H5 e1_real);
rewrite (meps_0_deterministic (toRExp e2) H8 e2_real).
rewrite (meps_0_deterministic (toRExp e1) H5 e1_real) in plus_real.
rewrite (meps_0_deterministic (toRExp e2) H8 e2_real) in plus_real.
(* Now unfold the float valued evaluation to get the deltas we need for the inequality *)
inversion plus_float; subst.
unfold perturb; simpl.
inversion H6; subst; inversion H7; subst.
unfold updEnv in H1,H12; simpl in *.
symmetry in H1,H12.
inversion H1; inversion H12; subst.
inversion H11; subst; inversion H14; subst.
unfold updEnv in H1, H13; simpl in *.
symmetry in H1,H13.
inversion H1; inversion H13; subst.
(* We have now obtained all necessary values from the evaluations --> remove them for readability *)
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.
unfold computeErrorR.
pose proof (Rabs_triang (e1R + - e1F) ((e2R + - e2F) + - ((e1F + e2F) * delta))).
pose proof (Rabs_triang (e1R + - e1F) ((e2R + - e2F) + - ((e1F + e2F) * delta0))).
destruct m;
repeat rewrite Ropp_plus_distr; try rewrite plus_bounds_simplify; try rewrite Rplus_assoc.
{ repeat rewrite <- Rplus_assoc.
......@@ -106,24 +100,22 @@ Qed.
Copy-Paste proof with minor differences, was easier then manipulating the evaluations and then applying the lemma
**)
Lemma subtract_abs_err_bounded (e1:expr Q) (e1R:R) (e1F:R) (e2:expr Q) (e2R:R)
(e2F:R) (vR:R) (vF:R) (E1 E2:env) err1 err2 (m m1 m2:mType) defVars fBits:
eval_expr E1 (toRMap defVars) fBits (toREval (toRExp e1)) e1R REAL ->
eval_expr E2 defVars fBits (toRExp e1) e1F m1 ->
eval_expr E1 (toRMap defVars) fBits (toREval (toRExp e2)) e2R REAL ->
eval_expr E2 defVars fBits (toRExp e2) e2F m2 ->
eval_expr E1 (toRMap defVars) fBits (toREval (Binop Sub (toRExp e1) (toRExp e2))) vR REAL ->
(e2F:R) (vR:R) (vF:R) (E1 E2:env) err1 err2 (m m1 m2:mType) defVars:
eval_expr E1 (toRMap defVars) (toREval (toRExp e1)) e1R REAL ->
eval_expr E2 defVars (toRExp e1) e1F m1 ->
eval_expr E1 (toRMap defVars) (toREval (toRExp e2)) e2R REAL ->
eval_expr E2 defVars (toRExp e2) e2F m2 ->
eval_expr E1 (toRMap defVars) (toREval (Binop Sub (toRExp e1) (toRExp e2))) vR REAL ->
eval_expr (updEnv 2 e2F (updEnv 1 e1F emptyEnv))
(updDefVars 2 m2 (updDefVars 1 m1 defVars))
(fun e =>
match e with
| Binop b (Var _ 1) (Var _ 2) => fBits (toRExp (Binop b e1 e2))
| _ => fBits e
end)
(updDefVars (Var R 2) m2 (updDefVars (Var R 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 + computeErrorR (e1F - e2F) m)%R.
Proof.
admit.
Admitted.
(*
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.
......@@ -184,24 +176,23 @@ Proof.
all: rewrite Rabs_Ropp, Rabs_mult, <- Rsub_eq_Ropp_Rplus.
all: eapply Rmult_le_compat_l; try auto using Rabs_pos.
Qed.
*)
Lemma mult_abs_err_bounded (e1:expr Q) (e1R:R) (e1F:R) (e2:expr Q) (e2R:R) (e2F:R)
(vR:R) (vF:R) (E1 E2:env) (m m1 m2:mType) defVars fBits:
eval_expr E1 (toRMap defVars) fBits (toREval (toRExp e1)) e1R REAL ->
eval_expr E2 defVars fBits (toRExp e1) e1F m1 ->
eval_expr E1 (toRMap defVars) fBits (toREval (toRExp e2)) e2R REAL ->
eval_expr E2 defVars fBits (toRExp e2) e2F m2 ->
eval_expr E1 (toRMap defVars) fBits (toREval (Binop Mult (toRExp e1) (toRExp e2))) vR REAL ->
(vR:R) (vF:R) (E1 E2:env) (m m1 m2:mType) defVars:
eval_expr E1 (toRMap defVars) (toREval (toRExp e1)) e1R REAL ->
eval_expr E2 defVars (toRExp e1) e1F m1 ->
eval_expr E1 (toRMap defVars) (toREval (toRExp e2)) e2R REAL ->
eval_expr E2 defVars (toRExp e2) e2F m2 ->
eval_expr E1 (toRMap defVars) (toREval (Binop Mult (toRExp e1) (toRExp e2))) vR REAL ->
eval_expr (updEnv 2 e2F (updEnv 1 e1F emptyEnv))
(updDefVars 2 m2 (updDefVars 1 m1 defVars))
(fun e =>
match e with
| Binop b (Var _ 1) (Var _ 2) => fBits (toRExp (Binop b e1 e2))
| _ => fBits e
end)
(updDefVars (Var R 2) m2 (updDefVars (Var R 1) m1 defVars))
(Binop Mult (Var R 1) (Var R 2)) vF m ->
(Rabs (vR - vF) <= Rabs (e1R * e2R - e1F * e2F) + computeErrorR (e1F * e2F) m)%R.
Proof.
admit.
Admitted.
(*
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;
......@@ -237,24 +228,23 @@ Proof.
all: eapply Rplus_le_compat_l; try auto.
all: eapply Rmult_le_compat_l; try auto using Rabs_pos.
Qed.
*)
Lemma div_abs_err_bounded (e1:expr Q) (e1R:R) (e1F:R) (e2:expr Q) (e2R:R) (e2F:R)
(vR:R) (vF:R) (E1 E2:env) (m m1 m2:mType) defVars fBits:
eval_expr E1 (toRMap defVars) fBits (toREval (toRExp e1)) e1R REAL ->
eval_expr E2 defVars fBits (toRExp e1) e1F m1 ->
eval_expr E1 (toRMap defVars) fBits (toREval (toRExp e2)) e2R REAL ->
eval_expr E2 defVars fBits (toRExp e2) e2F m2 ->
eval_expr E1 (toRMap defVars) fBits (toREval (Binop Div (toRExp e1) (toRExp e2))) vR REAL ->
(vR:R) (vF:R) (E1 E2:env) (m m1 m2:mType) defVars:
eval_expr E1 (toRMap defVars) (toREval (toRExp e1)) e1R REAL ->
eval_expr E2 defVars (toRExp e1) e1F m1 ->
eval_expr E1 (toRMap defVars) (toREval (toRExp e2)) e2R REAL ->
eval_expr E2 defVars (toRExp e2) e2F m2 ->
eval_expr E1 (toRMap defVars) (toREval (Binop Div (toRExp e1) (toRExp e2))) vR REAL ->
eval_expr (updEnv 2 e2F (updEnv 1 e1F emptyEnv))
(updDefVars 2 m2 (updDefVars 1 m1 defVars))
(fun e =>
match e with
| Binop b (Var _ 1) (Var _ 2) => fBits (toRExp (Binop b e1 e2))
| _ => fBits e
end)
(updDefVars (Var R 2) m2 (updDefVars (Var R 1) m1 defVars))
(Binop Div (Var R 1) (Var R 2)) vF m ->
(Rabs (vR - vF) <= Rabs (e1R / e2R - e1F / e2F) + computeErrorR (e1F / e2F) m)%R.
Proof.
admit.
Admitted.
(*
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 is e1R * e2R *)
inversion div_real; subst;
......@@ -290,27 +280,26 @@ Proof.
all: eapply Rplus_le_compat_l; try auto.
all: eapply Rmult_le_compat_l; try auto using Rabs_pos.
Qed.
*)
Lemma fma_abs_err_bounded (e1:expr Q) (e1R:R) (e1F:R) (e2:expr Q) (e2R:R) (e2F:R)
(e3:expr Q) (e3R:R) (e3F:R)
(vR:R) (vF:R) (E1 E2:env) (m m1 m2 m3:mType) defVars fBits:
eval_expr E1 (toRMap defVars) fBits (toREval (toRExp e1)) e1R REAL ->
eval_expr E2 defVars fBits (toRExp e1) e1F m1->
eval_expr E1 (toRMap defVars) fBits (toREval (toRExp e2)) e2R REAL ->
eval_expr E2 defVars fBits (toRExp e2) e2F m2 ->
eval_expr E1 (toRMap defVars) fBits (toREval (toRExp e3)) e3R REAL ->
eval_expr E2 defVars fBits (toRExp e3) e3F m3->
eval_expr E1 (toRMap defVars) fBits (toREval (Fma (toRExp e1) (toRExp e2) (toRExp e3))) vR REAL ->
(vR:R) (vF:R) (E1 E2:env) (m m1 m2 m3:mType) defVars:
eval_expr E1 (toRMap defVars) (toREval (toRExp e1)) e1R REAL ->
eval_expr E2 defVars (toRExp e1) e1F m1->
eval_expr E1 (toRMap defVars) (toREval (toRExp e2)) e2R REAL ->
eval_expr E2 defVars (toRExp e2) e2F m2 ->
eval_expr E1 (toRMap defVars) (toREval (toRExp e3)) e3R REAL ->
eval_expr E2 defVars (toRExp e3) e3F m3->
eval_expr E1 (toRMap defVars) (toREval (Fma (toRExp e1) (toRExp e2) (toRExp e3))) vR REAL ->
eval_expr (updEnv 3 e3F (updEnv 2 e2F (updEnv 1 e1F emptyEnv)))
(updDefVars 3 m3 (updDefVars 2 m2 (updDefVars 1 m1 defVars)))
(fun e =>
match e with
| Fma (Var _ 1) (Var _ 2) (Var _ 3) => fBits (toRExp (Fma e1 e2 e3))
| _ => fBits e
end)
(updDefVars (Var R 3) m3 (updDefVars (Var R 2) m2 (updDefVars (Var R 1) m1 defVars)))
(Fma (Var R 1) (Var R 2) (Var R 3)) vF m ->
(Rabs (vR - vF) <= Rabs ((e1R - e1F) + (e2R * e3R - e2F * e3F)) + computeErrorR (e1F + e2F * e3F ) m)%R.
Proof.
admit.
Admitted.
(*
intros e1_real e1_float e2_real e2_float e3_real e3_float fma_real fma_float.
inversion fma_real; subst;
assert (m0 = REAL) by (eapply toRMap_eval_REAL; eauto).
......@@ -363,21 +352,22 @@ Proof.
all: apply Rplus_le_compat_l.
all: rewrite Rabs_mult; apply Rmult_le_compat_l; auto using Rabs_pos.
Qed.
*)
Lemma round_abs_err_bounded (e:expr R) (nR nF1 nF:R) (E1 E2: env) (err:R)
(mEps m:mType) defVars fBits:
eval_expr E1 (toRMap defVars) fBits (toREval e) nR REAL ->
eval_expr E2 defVars fBits e nF1 m ->
(mEps m:mType) defVars:
eval_expr E1 (toRMap defVars) (toREval e) nR REAL ->
eval_expr E2 defVars e nF1 m ->
eval_expr (updEnv 1 nF1 emptyEnv)
(updDefVars 1 m defVars)
(fun e => match e with
| Downcast m (Var _ 1) => fBits (Downcast m e)
| _ => fBits e
end )
(updDefVars (Var R 1) m defVars)
(toRExp (Downcast mEps (Var Q 1))) nF mEps->
(Rabs (nR - nF1) <= err)%R ->
(Rabs (nR - nF) <= err + computeErrorR nF1 mEps)%R.
Proof.
admit.
Admitted.
(*
intros eval_real eval_float eval_float_rnd err_bounded.
replace (nR - nF)%R with ((nR - nF1) + (nF1 - nF))%R by lra.
eapply Rle_trans.
......@@ -400,6 +390,7 @@ Proof.
rewrite Ropp_plus_distr, <- Rplus_assoc.
rewrite Rplus_opp_r, Rplus_0_l, Rabs_Ropp; auto.
Qed.
*)
Lemma err_prop_inversion_pos_real nF nR err elo ehi
(float_iv_pos : (0 < elo - err)%R)
......
coq/ErrorValidation.v
View file @ 42885f73
This diff is collapsed.
coq/ExpressionSemantics.v 0 → 100644
View file @ 42885f73
From Coq
Require Import Reals.Reals.
From Flover.Infra
Require Import RealRationalProps RationalSimps Ltacs.
From Flover.Infra
Require Export ExpressionAbbrevs.
(**
Finally, define an error function that computes an errorneous value for a
given type. For a fixed-point datatype, truncation is used and any
floating-point type is perturbed. As we need not compute on this function we
define it in Prop.
**)
Definition perturb (rVal:R) (m:mType) (delta:R) :R :=
match m with
(* The Real-type has no error *)
|REAL => rVal
(* Fixed-point numbers have an absolute error *)
|F w f => rVal + delta
(* Floating-point numbers have a relative error *)
| _ => rVal * (1 + delta)
end.
Hint Unfold perturb.
(**
Define expression evaluation relation parametric by an "error" epsilon.
The result value exprresses float computations according to the IEEE standard,
using a perturbation of the real valued computation by (1 + delta), where
|delta| <= machine epsilon.
**)
Open Scope R_scope.
Inductive eval_expr (E:env)
(Gamma: expr R -> option mType)