Commit 3bf112d9 authored by Heiko Becker's avatar Heiko Becker
Browse files

Rework expression and cmd semantics for removing parameters distinction

parent bd83c45a
......@@ -2,7 +2,8 @@
Formalization of the Abstract Syntax Tree of a subset used in the Daisy framework
**)
Require Import Coq.Reals.Reals Coq.QArith.QArith.
Require Export Daisy.Infra.ExpressionAbbrevs.
Require Export Daisy.Infra.ExpressionAbbrevs Daisy.Infra.NatSet.
(**
Next define what a program is.
Currently no loops, only conditionals and assignments
......@@ -10,65 +11,41 @@ Require Export Daisy.Infra.ExpressionAbbrevs.
**)
Inductive cmd (V:Type) :Type :=
Let: nat -> exp V -> cmd V -> cmd V
| Ret: exp V -> cmd V
| Nop: cmd V.
| Ret: exp V -> cmd V.
(*| Nop: cmd V. *)
(**
(*
UNUSED!
Small Step semantics for Daisy language
**)
Inductive sstep : cmd R -> env -> env -> precond -> R -> cmd R -> env -> Prop :=
let_s x e s VarEnv ParamEnv P v eps:
eval_exp eps VarEnv ParamEnv P e v ->
sstep (Let R x e s) VarEnv ParamEnv P eps s (updEnv x v VarEnv)
|ret_s e VarEnv ParamEnv P v eps:
eval_exp eps VarEnv ParamEnv P e v ->
sstep (Ret R e) VarEnv ParamEnv P eps (Nop R) (updEnv 0 v VarEnv).
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).
*)
(**
Analogously define Big Step semantics for the Daisy language
**)
Inductive bstep : cmd R -> env -> env -> precond -> R -> cmd R -> R -> Prop :=
let_b x e s s' VarEnv ParamEnv P v eps res:
eval_exp eps VarEnv ParamEnv P e v ->
bstep s (updEnv x v VarEnv) ParamEnv P eps s' res ->
bstep (Let R x e s) VarEnv ParamEnv P eps s' res
|ret_b e VarEnv ParamEnv P v eps:
eval_exp eps VarEnv ParamEnv P e v ->
bstep (Ret R e) VarEnv ParamEnv P eps (Nop R) v.
Fixpoint substitute_exp (v:nat) (e:exp Q) (e_old:exp Q) :=
match e_old with
|Var _ v_old => if (v =? v_old) then e else Var Q v_old
|Unop op e' => Unop op (substitute_exp v e e')
|Binop op e1 e2 => Binop op (substitute_exp v e e1) (substitute_exp v e e2)
|e => e
end.
Inductive bstep : cmd R -> env -> precond -> R -> R -> Prop :=
let_b x e s E P v eps res:
eval_exp eps E P e v ->
bstep s (updEnv x v E) P eps res ->
bstep (Let x e s) E P eps res
|ret_b e E P v eps:
eval_exp eps E P e v ->
bstep (Ret e) E P eps v.
Fixpoint substitute (v:nat) (e:exp Q) (f:cmd Q) :=
Fixpoint freeVars (f:cmd Q) :NatSet.t :=
match f with
|Let _ x e_x g =>
let new_e := substitute_exp v e e_x in
Let Q x new_e (substitute v e g)
|Ret _ e_ret => Ret Q (substitute_exp v e e_ret)
|Nop _ => Nop Q
| Let x e1 g => NatSet.remove x (NatSet.union (Expressions.freeVars e1) (freeVars g))
| Ret e => Expressions.freeVars e
end.
Fixpoint expand_lets (f:cmd Q) (fuel:nat) :option (cmd Q):=
match fuel with
|0%nat => Some f
|S fuel' =>
match f with
|Let _ x e g =>
(expand_lets (substitute x e g) fuel')
|Ret _ e => Some (Ret Q e)
|Nop _ => None
end
end.
Fixpoint count_lets (f:cmd Q) :nat :=
Fixpoint definedVars (f:cmd Q) :NatSet.t :=
match f with
|Let _ x e g => S (count_lets g)
| _ => 0%nat
end.
Definition expand (f:cmd Q) := expand_lets f (count_lets f).
\ No newline at end of file
| Let x _ g => NatSet.add x (definedVars g)
| Ret _ => NatSet.empty
end.
\ No newline at end of file
(**
Environment library.
Defines the environment type for the Daisy framework and a simulation relation between environments.
FIXME: Would it make sense to differenciate between a parameter environment and a variable environment?
**)
Require Import Coq.Reals.Reals Coq.micromega.Psatz Coq.QArith.Qreals.
Require Import Daisy.Infra.ExpressionAbbrevs Daisy.Commands.
Require Import Daisy.Infra.ExpressionAbbrevs Daisy.Infra.RationalSimps Daisy.Commands.
(**
Define an approximation relation between two environments.
......@@ -13,8 +12,24 @@ 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 -> env -> Prop :=
|approxRefl E A: approxEnv E A E
|approxUpd E1 E2 A v1 v2 x: approxEnv E1 A E2 ->
(Rabs (v1 - v2) <= Q2R (snd (A (Var Q x))))%R ->
approxEnv (updEnv x v1 E1) A (updEnv x v2 E2).
\ No newline at end of file
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) <= v1 * Q2R machineEpsilon)%R ->
NatSet.mem x 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 ->
(Rabs (v1 - v2) <= Q2R (snd (A (Var Q x))))%R ->
NatSet.mem x fVars = false ->
approxEnv (updEnv x v1 E1) 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).
......@@ -7,9 +7,9 @@ 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 (P:precond) (n:R) (nR:R) (nF:R) (VarEnv1 VarEnv2 ParamEnv:env) (absenv:analysisResult):
eval_exp 0%R VarEnv1 ParamEnv P (Const n) nR ->
eval_exp (Q2R machineEpsilon) VarEnv2 ParamEnv P (Const n) nF ->
Lemma const_abs_err_bounded (P:precond) (n:R) (nR:R) (nF:R) (E1 E2:env) (absenv:analysisResult):
eval_exp 0%R E1 P (Const n) nR ->
eval_exp (Q2R machineEpsilon) E2 P (Const n) nF ->
(Rabs (nR - nF) <= Rabs n * (Q2R machineEpsilon))%R.
Proof.
intros eval_real eval_float.
......@@ -21,30 +21,34 @@ Proof.
apply Rmult_le_compat_l; [apply Rabs_pos | auto].
Qed.
Lemma param_abs_err_bounded (P:precond) (n:nat) (nR:R) (nF:R) (VarEnv1 VarEnv2 ParamEnv:env) (absenv:analysisResult):
eval_exp 0%R VarEnv1 ParamEnv P (Param R n) nR ->
eval_exp (Q2R machineEpsilon) VarEnv2 ParamEnv P (Param R n) nF ->
(Rabs (nR - nF) <= Rabs (ParamEnv n) * (Q2R machineEpsilon))%R.
(*
Lemma param_abs_err_bounded (P:precond) (n:nat) (nR:R) (nF:R) (E1 E2:env) (absenv:analysisResult):
eval_exp 0%R E1 P (Param R n) nR ->
eval_exp (Q2R machineEpsilon) E2 P (Param R n) nF ->
(Rabs (nR - nF) <= * (Q2R machineEpsilon))%R.
Proof.
intros eval_real eval_float.
inversion eval_real; subst.
rewrite delta_0_deterministic; auto.
inversion eval_float; subst.
unfold perturb; simpl.
exists v; split; try auto.
rewrite H3 in H8; inversion H8.
rewrite Rabs_err_simpl.
repeat rewrite Rabs_mult.
apply Rmult_le_compat_l; [ apply Rabs_pos | auto].
Qed.
*)
Lemma add_abs_err_bounded (e1:exp Q) (e1R:R) (e1F:R) (e2:exp Q) (e2R:R) (e2F:R)
(vR:R) (vF:R) (VarEnv1 VarEnv2 ParamEnv:env) (P:precond)
(err1 err2 :Q):
eval_exp 0%R VarEnv1 ParamEnv P (toRExp e1) e1R ->
eval_exp (Q2R machineEpsilon) VarEnv2 ParamEnv P (toRExp e1) e1F ->
eval_exp 0%R VarEnv1 ParamEnv P (toRExp e2) e2R ->
eval_exp (Q2R machineEpsilon) VarEnv2 ParamEnv P (toRExp e2) e2F ->
eval_exp 0%R VarEnv1 ParamEnv P (Binop Plus (toRExp e1) (toRExp e2)) vR ->
eval_exp (Q2R machineEpsilon) (updEnv 2 e2F (updEnv 1 e1F VarEnv2)) ParamEnv P (Binop Plus (Var R 1) (Var R 2)) vF ->
(vR:R) (vF:R) (E1 E2:env) (P1 P2:precond) (err1 err2 :Q):
eval_exp 0%R E1 P1 (toRExp e1) e1R ->
eval_exp (Q2R machineEpsilon) E2 P1 (toRExp e1) e1F ->
eval_exp 0%R E1 P1 (toRExp e2) e2R ->
eval_exp (Q2R machineEpsilon) E2 P1 (toRExp e2) e2F ->
eval_exp 0%R E1 P1 (Binop Plus (toRExp e1) (toRExp e2)) vR ->
eval_exp (Q2R machineEpsilon) (updEnv 2 e2F (updEnv 1 e1F emptyEnv)) P2 (Binop Plus (Var R 1) (Var R 2)) vF ->
(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.
......@@ -66,8 +70,11 @@ Proof.
unfold perturb; simpl.
inversion H4; subst; inversion H5; subst.
unfold updEnv; simpl.
unfold updEnv in H0,H7; simpl in *.
symmetry in H0, H7.
inversion H0; inversion H7; subst.
(* We have now obtained all necessary values from the evaluations --> remove them for readability *)
clear plus_float H4 H5 plus_real e1_real e1_float e2_real e2_float.
clear plus_float H4 H5 plus_real e1_real e1_float e2_real e2_float H0 H7.
repeat rewrite Rmult_plus_distr_l.
rewrite Rmult_1_r.
rewrite Rsub_eq_Ropp_Rplus.
......@@ -80,7 +87,7 @@ Proof.
pose proof (Rabs_triang (e2R + - e2F) (- ((e1F + e2F) * delta))).
pose proof (Rplus_le_compat_l (Rabs (e1R + - e1F)) _ _ H0).
eapply Rle_trans.
apply H1.
apply H4.
rewrite <- Rplus_assoc.
repeat rewrite <- Rsub_eq_Ropp_Rplus.
rewrite Rabs_Ropp.
......@@ -98,13 +105,13 @@ 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) (VarEnv1 VarEnv2 ParamEnv:nat->R) P err1 err2:
eval_exp 0%R VarEnv1 ParamEnv P (toRExp e1) e1R ->
eval_exp (Q2R machineEpsilon) VarEnv2 ParamEnv P (toRExp e1) e1F ->
eval_exp 0%R VarEnv1 ParamEnv P (toRExp e2) e2R ->
eval_exp (Q2R machineEpsilon) VarEnv2 ParamEnv P (toRExp e2) e2F ->
eval_exp 0%R VarEnv1 ParamEnv P (Binop Sub (toRExp e1) (toRExp e2)) vR ->
eval_exp (Q2R machineEpsilon) (updEnv 2 e2F (updEnv 1 e1F VarEnv2)) ParamEnv P (Binop Sub (Var R 1) (Var R 2)) vF ->
(e2F:R) (vR:R) (vF:R) (E1 E2:env) P1 P2 err1 err2:
eval_exp 0%R E1 P1 (toRExp e1) e1R ->
eval_exp (Q2R machineEpsilon) E2 P1 (toRExp e1) e1F ->
eval_exp 0%R E1 P1 (toRExp e2) e2R ->
eval_exp (Q2R machineEpsilon) E2 P1 (toRExp e2) e2F ->
eval_exp 0%R E1 P1 (Binop Sub (toRExp e1) (toRExp e2)) vR ->
eval_exp (Q2R machineEpsilon) (updEnv 2 e2F (updEnv 1 e1F emptyEnv)) P2 (Binop Sub (Var R 1) (Var R 2)) vF ->
(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.
......@@ -126,8 +133,11 @@ Proof.
unfold perturb; simpl.
inversion H4; subst; inversion H5; subst.
unfold updEnv; simpl.
symmetry in H0, H7.
unfold updEnv in H0, H7; simpl in H0, H7.
inversion H0; inversion H7; subst.
(* We have now obtained all necessary values from the evaluations --> remove them for readability *)
clear sub_float H4 H5 sub_real e1_real e1_float e2_real e2_float.
clear sub_float H4 H5 sub_real e1_real e1_float e2_real e2_float H0 H1.
repeat rewrite Rmult_plus_distr_l.
rewrite Rmult_1_r.
repeat rewrite Rsub_eq_Ropp_Rplus.
......@@ -151,13 +161,13 @@ 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) (VarEnv1 VarEnv2 ParamEnv:env) (P:precond):
eval_exp 0%R VarEnv1 ParamEnv P (toRExp e1) e1R ->
eval_exp (Q2R machineEpsilon) VarEnv2 ParamEnv P (toRExp e1) e1F ->
eval_exp 0%R VarEnv1 ParamEnv P (toRExp e2) e2R ->
eval_exp (Q2R machineEpsilon) VarEnv2 ParamEnv P (toRExp e2) e2F ->
eval_exp 0%R VarEnv1 ParamEnv P (Binop Mult (toRExp e1) (toRExp e2)) vR ->
eval_exp (Q2R machineEpsilon) (updEnv 2 e2F (updEnv 1 e1F VarEnv2)) ParamEnv P (Binop Mult (Var R 1) (Var R 2)) vF ->
(vR:R) (vF:R) (E1 E2:env) (P1 P2:precond):
eval_exp 0%R E1 P1 (toRExp e1) e1R ->
eval_exp (Q2R machineEpsilon) E2 P1 (toRExp e1) e1F ->
eval_exp 0%R E1 P1 (toRExp e2) e2R ->
eval_exp (Q2R machineEpsilon) E2 P1 (toRExp e2) e2F ->
eval_exp 0%R E1 P1 (Binop Mult (toRExp e1) (toRExp e2)) vR ->
eval_exp (Q2R machineEpsilon) (updEnv 2 e2F (updEnv 1 e1F emptyEnv)) P2 (Binop Mult (Var R 1) (Var R 2)) vF ->
(Rabs (vR - vF) <= Rabs (e1R * e2R - e1F * e2F) + Rabs (e1F * e2F) * (Q2R machineEpsilon))%R.
Proof.
intros e1_real e1_float e2_real e2_float mult_real mult_float.
......@@ -176,9 +186,11 @@ Proof.
inversion mult_float; subst.
unfold perturb; simpl.
inversion H4; subst; inversion H5; subst.
unfold updEnv; simpl.
symmetry in H0, H7;
unfold updEnv in *; simpl in *.
inversion H0; inversion H7; subst.
(* We have now obtained all necessary values from the evaluations --> remove them for readability *)
clear mult_float H4 H5 mult_real e1_real e1_float e2_real e2_float.
clear mult_float H4 H5 mult_real e1_real e1_float e2_real e2_float H0 H1.
repeat rewrite Rmult_plus_distr_l.
rewrite Rmult_1_r.
rewrite Rsub_eq_Ropp_Rplus.
......@@ -196,13 +208,13 @@ 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) (VarEnv1 VarEnv2 ParamEnv:env) (P:precond):
eval_exp 0%R VarEnv1 ParamEnv P (toRExp e1) e1R ->
eval_exp (Q2R machineEpsilon) VarEnv2 ParamEnv P (toRExp e1) e1F ->
eval_exp 0%R VarEnv1 ParamEnv P (toRExp e2) e2R ->
eval_exp (Q2R machineEpsilon) VarEnv2 ParamEnv P (toRExp e2) e2F ->
eval_exp 0%R VarEnv1 ParamEnv P (Binop Div (toRExp e1) (toRExp e2)) vR ->
eval_exp (Q2R machineEpsilon) (updEnv 2 e2F (updEnv 1 e1F VarEnv2)) ParamEnv P (Binop Div (Var R 1) (Var R 2)) vF ->
(vR:R) (vF:R) (E1 E2:env) (P1 P2:precond):
eval_exp 0%R E1 P1 (toRExp e1) e1R ->
eval_exp (Q2R machineEpsilon) E2 P1 (toRExp e1) e1F ->
eval_exp 0%R E1 P1 (toRExp e2) e2R ->
eval_exp (Q2R machineEpsilon) E2 P1 (toRExp e2) e2F ->
eval_exp 0%R E1 P1 (Binop Div (toRExp e1) (toRExp e2)) vR ->
eval_exp (Q2R machineEpsilon) (updEnv 2 e2F (updEnv 1 e1F emptyEnv)) P2 (Binop Div (Var R 1) (Var R 2)) vF ->
(Rabs (vR - vF) <= Rabs (e1R / e2R - e1F / e2F) + Rabs (e1F / e2F) * (Q2R machineEpsilon))%R.
Proof.
intros e1_real e1_float e2_real e2_float div_real div_float.
......@@ -221,9 +233,11 @@ Proof.
inversion div_float; subst.
unfold perturb; simpl.
inversion H4; subst; inversion H5; subst.
unfold updEnv; simpl.
symmetry in H0, H7;
unfold updEnv in *; simpl in *.
inversion H0; inversion H7; subst.
(* We have now obtained all necessary values from the evaluations --> remove them for readability *)
clear div_float H4 H5 div_real e1_real e1_float e2_real e2_float.
clear div_float H4 H5 div_real e1_real e1_float e2_real e2_float H0 H1.
repeat rewrite Rmult_plus_distr_l.
rewrite Rmult_1_r.
rewrite Rsub_eq_Ropp_Rplus.
......
......@@ -12,48 +12,49 @@ Require Import Daisy.Infra.Abbrevs Daisy.Infra.RationalSimps Daisy.Infra.RealRat
Require Import Daisy.Environments Daisy.IntervalValidation Daisy.ErrorBounds.
(** Error bound validator **)
Fixpoint validErrorbound (e:exp Q) (absenv:analysisResult) :=
Fixpoint validErrorbound (e:exp Q) (absenv:analysisResult) (dVars:NatSet.t):=
let (intv, err) := (absenv e) in
let errPos := Qleb 0 err in
match e with
|Var _ v => errPos (* Variables will have been checked before *)
|Param _ v => andb errPos (Qleb (maxAbs intv * RationalSimps.machineEpsilon) err)
|Const n => andb errPos (Qleb (maxAbs intv * RationalSimps.machineEpsilon) err)
|Unop _ _ => false
|Binop b e1 e2 =>
let (ive1, err1) := absenv e1 in
let (ive2, err2) := absenv e2 in
let rec := andb (validErrorbound e1 absenv) (validErrorbound e2 absenv) in
let errIve1 := widenIntv ive1 err1 in
let errIve2 := widenIntv ive2 err2 in
let upperBoundE1 := maxAbs ive1 in
let upperBoundE2 := maxAbs ive2 in
let theVal :=
match b with
| Plus => Qleb (err1 + err2 + (maxAbs (addIntv errIve1 errIve2)) * RationalSimps.machineEpsilon) err
| Sub => Qleb (err1 + err2 + (maxAbs (subtractIntv errIve1 errIve2)) * RationalSimps.machineEpsilon) err
| Mult => Qleb ((upperBoundE1 * err2 + upperBoundE2 * err1 + err1 * err2) + (maxAbs (multIntv errIve1 errIve2)) * RationalSimps.machineEpsilon) err
| Div => let upperBoundInvE2 := maxAbs (invertIntv ive2) in
let nodiv0_fl := orb
(andb (Qleb (ivhi errIve2) 0) (negb (Qeq_bool (ivhi errIve2) 0)))
(andb (Qleb 0 (ivlo errIve2)) (negb (Qeq_bool (ivlo errIve2) 0))) in
if nodiv0_fl
then let minAbsIve2 := minAbs (errIve2) in
let errInv := (1 / (minAbsIve2 * minAbsIve2)) * err2 in
Qleb ((upperBoundE1 * errInv + upperBoundInvE2 * err1 + err1 * errInv) + (maxAbs (divideIntv errIve1 errIve2)) * RationalSimps.machineEpsilon) err
else false
end
in andb (andb rec errPos) theVal
end.
let res :=
match e with
|Var _ v => if (NatSet.mem v dVars) then true else (Qleb (maxAbs intv * RationalSimps.machineEpsilon) err)
|Const n => Qleb (maxAbs intv * RationalSimps.machineEpsilon) err
|Unop _ _ => false
|Binop b e1 e2 =>
let (ive1, err1) := absenv e1 in
let (ive2, err2) := absenv e2 in
let rec := andb (validErrorbound e1 absenv dVars) (validErrorbound e2 absenv dVars) in
let errIve1 := widenIntv ive1 err1 in
let errIve2 := widenIntv ive2 err2 in
let upperBoundE1 := maxAbs ive1 in
let upperBoundE2 := maxAbs ive2 in
let theVal :=
match b with
| Plus => Qleb (err1 + err2 + (maxAbs (addIntv errIve1 errIve2)) * RationalSimps.machineEpsilon) err
| Sub => Qleb (err1 + err2 + (maxAbs (subtractIntv errIve1 errIve2)) * RationalSimps.machineEpsilon) err
| Mult => Qleb ((upperBoundE1 * err2 + upperBoundE2 * err1 + err1 * err2) + (maxAbs (multIntv errIve1 errIve2)) * RationalSimps.machineEpsilon) err
| Div => let upperBoundInvE2 := maxAbs (invertIntv ive2) in
let nodiv0_fl := orb
(andb (Qleb (ivhi errIve2) 0) (negb (Qeq_bool (ivhi errIve2) 0)))
(andb (Qleb 0 (ivlo errIve2)) (negb (Qeq_bool (ivlo errIve2) 0))) in
if nodiv0_fl
then let minAbsIve2 := minAbs (errIve2) in
let errInv := (1 / (minAbsIve2 * minAbsIve2)) * err2 in
Qleb ((upperBoundE1 * errInv + upperBoundInvE2 * err1 + err1 * errInv) + (maxAbs (divideIntv errIve1 errIve2)) * RationalSimps.machineEpsilon) err
else false
end
in andb rec theVal
end
in
andb errPos res.
(** Error bound command validator **)
Fixpoint validErrorboundCmd (f:cmd Q) (env:analysisResult) {struct f} : bool :=
Fixpoint validErrorboundCmd (f:cmd Q) (env:analysisResult) (dVars:NatSet.t) {struct f} : bool :=
match f with
|Let _ x e g =>
(validErrorbound e env) && (Qeq_bool (snd (env e)) (snd (env (Var Q x)))) &&
validErrorboundCmd g env
|Ret _ e => validErrorbound e env && (Qeq_bool (snd (env e)) (snd (env (Var Q 0))))
|Nop _ => false
|Let x e g =>
(validErrorbound e env dVars) && (Qeq_bool (snd (env e)) (snd (env (Var Q x)))) &&
validErrorboundCmd g env (NatSet.add x dVars)
|Ret e => validErrorbound e env dVars
end.
(**
......@@ -61,60 +62,98 @@ Fixpoint validErrorboundCmd (f:cmd Q) (env:analysisResult) {struct f} : bool :=
This lemma enables us to deduce from each run of the validator the invariant
that when it succeeds, the errors must be positive.
**)
Lemma err_always_positive e (absenv:analysisResult) iv err:
validErrorbound e absenv = true ->
Lemma err_always_positive e (absenv:analysisResult) iv err dVars:
validErrorbound e absenv dVars = true ->
(iv,err) = absenv e ->
(0 <= Q2R err)%R.
Proof.
destruct e;intros validErrorbound_e absenv_e;
unfold validErrorbound in validErrorbound_e;
rewrite <- absenv_e in validErrorbound_e; simpl in *.
- apply Qle_bool_iff in validErrorbound_e; apply Qle_Rle in validErrorbound_e.
rewrite Q2R0_is_0 in validErrorbound_e; auto.
- andb_to_prop validErrorbound_e.
apply Qle_bool_iff in L; apply Qle_Rle in L; rewrite Q2R0_is_0 in L; auto.
- andb_to_prop validErrorbound_e.
apply Qle_bool_iff in L; apply Qle_Rle in L; rewrite Q2R0_is_0 in L; auto.
- inversion validErrorbound_e.
- destruct (absenv e1). destruct (absenv e2).
andb_to_prop validErrorbound_e.
apply Qle_bool_iff in R0; apply Qle_Rle in R0; rewrite Q2R0_is_0 in R0; auto.
rewrite <- absenv_e in validErrorbound_e; simpl in *;
andb_to_prop validErrorbound_e.
- apply Qle_bool_iff in L; apply Qle_Rle in L; rewrite Q2R0_is_0 in L; auto.
- apply Qle_bool_iff in L; apply Qle_Rle in L; rewrite Q2R0_is_0 in L; auto.
- inversion R.
- apply Qle_bool_iff in L; apply Qle_Rle in L; rewrite Q2R0_is_0 in L; auto.
Qed.
Lemma validErrorboundCorrectVariable:
forall VarEnv1 VarEnv2 ParamEnv absenv (v:nat) nR nF e nlo nhi (P:precond),
approxEnv VarEnv1 absenv VarEnv2 ->
eval_exp 0%R VarEnv1 ParamEnv P (toRExp (Var Q v)) nR ->
eval_exp (Q2R (RationalSimps.machineEpsilon)) VarEnv2 ParamEnv P (toRExp (Var Q v)) nF ->
validErrorbound (Var Q v) absenv = true ->
forall E1 E2 absenv (v:nat) nR nF e nlo nhi (P:precond) fVars dVars,
approxEnv E1 absenv fVars dVars E2 ->
eval_exp 0%R E1 P (toRExp (Var Q v)) nR ->
eval_exp (Q2R (RationalSimps.machineEpsilon)) E2 P (toRExp (Var Q v)) nF ->
validErrorbound (Var Q v) absenv dVars = true ->
absenv (Var Q v) = ((nlo,nhi),e) ->
(Rabs (nR - nF) <= (Q2R e))%R.
Proof.
intros cenv1 cenv2 PEnv absenv v nR nF e nlo nhi P approxCEnv eval_real eval_float
intros E1 E2 absenv v nR nF e nlo nhi P fVars dVars approxCEnv eval_real eval_float
error_valid absenv_var.
inversion eval_real; inversion eval_float; subst.
unfold validErrorbound in error_valid.
rewrite absenv_var in *; simpl in *.
andb_to_prop error_valid.
rename R into error_valid.
rename L into error_pos.
induction approxCEnv.
- rewrite Rminus_diag_eq; [ | reflexivity].
rewrite Rabs_R0.
eapply err_always_positive; eauto.
- unfold updEnv.
case_eq (v =? x); intros eq_case; subst.
+ rewrite Nat.eqb_eq in eq_case. rewrite <- eq_case in H.
- unfold emptyEnv in *; simpl in *.
inversion H0.
- unfold updEnv in *; simpl in *.
case_eq (v =? x); intros eq_case; rewrite eq_case in *.
+ rewrite Nat.eqb_eq in eq_case; subst.
rewrite H4 in error_valid.
inversion H0; inversion H6; subst.
eapply Rle_trans.
apply H.
repeat (rewrite delta_0_deterministic in H3; auto).
apply Qle_bool_iff in error_valid.
apply Qle_Rle in error_valid.
eapply Rle_trans.
Focus 2.
apply error_valid.
admit.
+ apply IHapproxCEnv; try auto.
{ apply (Var_load _ P _ H0 H1 H2 H3). }
{ apply (Var_load _ _ _ H6 H7 H8 H9). }
- unfold updEnv in *; simpl in *.
case_eq (v =? x); intros eq_case; rewrite eq_case in *.
+ rewrite Nat.eqb_eq in eq_case; subst.
symmetry in H0, H6;
inversion H0; inversion H6;
subst.
rewrite absenv_var in H; auto.
+ apply IHapproxCEnv; auto; apply Var_load.
Qed.
+ unfold updEnv in *; simpl in *.
apply IHapproxCEnv; try auto.
admit.
admit.
case_eq (NatSet.mem v dVars);
intros case_dVars; rewrite case_dVars in *; simpl in *.
* auto.
* assert (NatSet.mem v (NatSet.add x dVars) = false) as not_in_add.
{ case_eq (NatSet.mem v (NatSet.add x dVars));
intros case_add; rewrite case_add in *; simpl in *.
- rewrite NatSet.mem_spec in case_add.
rewrite NatSet.add_spec in case_add.
destruct case_add; subst.
+ rewrite Nat.eqb_neq in eq_case. exfalso; apply eq_case; auto.
+ rewrite <- NatSet.mem_spec in H5. rewrite H5 in case_dVars.
inversion case_dVars.
- auto. }
{ rewrite not_in_add in error_valid.
auto.
Admitted.
Lemma validErrorboundCorrectConstant:
forall VarEnv1 VarEnv2 ParamEnv absenv (n:Q) nR nF e nlo nhi (P:precond),
eval_exp 0%R VarEnv1 ParamEnv P (Const (Q2R n)) nR ->
eval_exp (Q2R (RationalSimps.machineEpsilon)) VarEnv2 ParamEnv P (Const (Q2R n)) nF ->
validErrorbound (Const n) absenv = true ->
forall E1 E2 absenv (n:Q) nR nF e nlo nhi (P:precond) dVars,
eval_exp 0%R E1 P (Const (Q2R n)) nR ->
eval_exp (Q2R (RationalSimps.machineEpsilon)) E2 P (Const (Q2R n)) nF ->
validErrorbound (Const n) absenv dVars = true ->
(Q2R nlo <= nR <= Q2R nhi)%R ->
absenv (Const n) = ((nlo,nhi),e) ->
(Rabs (nR - nF) <= (Q2R e))%R.
Proof.
intros cenv1 cenv2 PEnv absenv n nR nF e nlo nhi P.
intros eval_real eval_float error_valid intv_valid absenv_const.
intros E1 E2 absenv n nR nF e nlo nhi P dVars
eval_real eval_float error_valid intv_valid absenv_const.
eapply Rle_trans.
eapply const_abs_err_bounded; eauto.
unfold validErrorbound in error_valid.
......@@ -134,31 +173,28 @@ Proof.
rewrite <- maxAbs_impl_RmaxAbs in error_valid; auto.
Qed.
(*
Lemma validErrorboundCorrectParam:
forall VarEnv1 VarEnv2 ParamEnv absenv (v:nat) nR nF e P plo phi,
eval_exp 0%R VarEnv1 ParamEnv P (toRExp (Param Q v)) nR ->
eval_exp (Q2R RationalSimps.machineEpsilon) VarEnv2 ParamEnv P (toRExp (Param Q v)) nF ->
forall E1 E2 absenv (v:nat) nR nF e P plo phi,
eval_exp 0%R E1 P (toRExp (Param Q v)) nR ->
eval_exp (Q2R RationalSimps.machineEpsilon) E2 P (toRExp (Param Q v)) nF ->
validErrorbound (Param Q v) absenv = true ->