Commit 7ac1c370 authored by ='s avatar =
Browse files

New typing, proved sound. Also, expressions do not contain machine precision...

New typing, proved sound. Also, expressions do not contain machine precision anymore in the case of variables
parent 777b1d10
...@@ -49,14 +49,14 @@ Inductive sstep : cmd R -> env -> R -> cmd R -> env -> Prop := ...@@ -49,14 +49,14 @@ Inductive sstep : cmd R -> env -> R -> cmd R -> env -> Prop :=
Define big step semantics for the Daisy language, terminating on a "returned" Define big step semantics for the Daisy language, terminating on a "returned"
result value result value
**) **)
Inductive bstep : cmd R -> env -> R -> mType -> Prop := Inductive bstep : cmd R -> env -> (nat -> option mType) -> R -> mType -> Prop :=
let_b m m' x e s E v res: let_b m m' x e s E v res defVars:
eval_exp E e v m -> eval_exp E defVars e v m ->
bstep s (updEnv x m v E) res m' -> bstep s (updEnv x m v E) defVars res m' ->
bstep (Let m x e s) E res m' bstep (Let m x e s) E defVars res m'
|ret_b m e E v: |ret_b m e E v defVars:
eval_exp E e v m -> eval_exp E defVars e v m ->
bstep (Ret e) E v m. bstep (Ret e) E defVars v m.
......
...@@ -22,7 +22,7 @@ Inductive approxEnv : env -> analysisResult -> NatSet.t -> NatSet.t -> env -> Pr ...@@ -22,7 +22,7 @@ Inductive approxEnv : env -> analysisResult -> NatSet.t -> NatSet.t -> env -> Pr
approxEnv (updEnv x M0 v1 E1) A (NatSet.add x fVars) dVars (updEnv x m v2 E2) approxEnv (updEnv x M0 v1 E1) A (NatSet.add x fVars) dVars (updEnv x m v2 E2)
|approxUpdBound E1 E2 A v1 v2 x fVars dVars m: |approxUpdBound E1 E2 A v1 v2 x fVars dVars m:
approxEnv E1 A fVars dVars E2 -> approxEnv E1 A fVars dVars E2 ->
(Rabs (v1 - v2) <= Q2R (snd (A (Var Q m x))))%R -> (Rabs (v1 - v2) <= Q2R (snd (A (Var Q x))))%R ->
NatSet.mem x (NatSet.union fVars dVars) = false -> NatSet.mem x (NatSet.union fVars dVars) = false ->
approxEnv (updEnv x M0 v1 E1) A fVars (NatSet.add x dVars) (updEnv x m v2 E2). approxEnv (updEnv x M0 v1 E1) A fVars (NatSet.add x dVars) (updEnv x m v2 E2).
......
...@@ -7,9 +7,9 @@ Require Import Coq.Reals.Reals Coq.micromega.Psatz Coq.QArith.QArith Coq.QArith. ...@@ -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.Infra.Abbrevs Daisy.Infra.RationalSimps Daisy.Infra.RealSimps Daisy.Infra.RealRationalProps.
Require Import Daisy.Environments Daisy.Infra.ExpressionAbbrevs. Require Import Daisy.Environments Daisy.Infra.ExpressionAbbrevs.
Lemma const_abs_err_bounded (n:R) (nR:R) (nF:R) (E1 E2:env) (absenv:analysisResult) (m:mType): Lemma const_abs_err_bounded (n:R) (nR:R) (nF:R) (E1 E2:env) (absenv:analysisResult) (m:mType) defVars:
eval_exp E1 (Const M0 n) nR M0 -> eval_exp E1 defVars (Const M0 n) nR M0 ->
eval_exp E2 (Const m n) nF m -> eval_exp E2 defVars (Const m n) nF m ->
(Rabs (nR - nF) <= Rabs n * (Q2R (meps m)))%R. (Rabs (nR - nF) <= Rabs n * (Q2R (meps m)))%R.
Proof. Proof.
intros eval_real eval_float. intros eval_real eval_float.
...@@ -44,13 +44,13 @@ Qed. ...@@ -44,13 +44,13 @@ Qed.
*) *)
Lemma add_abs_err_bounded (e1:exp Q) (e1R:R) (e1F:R) (e2:exp Q) (e2R:R) (e2F:R) 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) (m m1 m2:mType): (vR:R) (vF:R) (E1 E2:env) (err1 err2 :Q) (m m1 m2:mType) defVars:
eval_exp E1 (toREval (toRExp e1)) e1R M0 -> eval_exp E1 defVars (toREval (toRExp e1)) e1R M0 ->
eval_exp E2 (toRExp e1) e1F m1-> eval_exp E2 defVars (toRExp e1) e1F m1->
eval_exp E1 (toREval (toRExp e2)) e2R M0 -> eval_exp E1 defVars (toREval (toRExp e2)) e2R M0 ->
eval_exp E2 (toRExp e2) e2F m2 -> eval_exp E2 defVars (toRExp e2) e2F m2 ->
eval_exp E1 (toREval (Binop Plus (toRExp e1) (toRExp e2))) vR M0 -> eval_exp E1 defVars (toREval (Binop Plus (toRExp e1) (toRExp e2))) vR M0 ->
eval_exp (updEnv 2 m2 e2F (updEnv 1 m1 e1F emptyEnv)) (Binop Plus (Var R m1 1) (Var R m2 2)) vF m-> eval_exp (updEnv 2 m2 e2F (updEnv 1 m1 e1F emptyEnv)) defVars (Binop Plus (Var R 1) (Var R 2)) vF m->
(Rabs (e1R - e1F) <= Q2R err1)%R -> (Rabs (e1R - e1F) <= Q2R err1)%R ->
(Rabs (e2R - e2F) <= Q2R err2)%R -> (Rabs (e2R - e2F) <= Q2R err2)%R ->
(Rabs (vR - vF) <= Q2R err1 + Q2R err2 + (Rabs (e1F + e2F) * (Q2R (meps m))))%R. (Rabs (vR - vF) <= Q2R err1 + Q2R err2 + (Rabs (e1F + e2F) * (Q2R (meps m))))%R.
...@@ -74,11 +74,11 @@ Proof. ...@@ -74,11 +74,11 @@ Proof.
unfold perturb; simpl. unfold perturb; simpl.
inversion H4; subst; inversion H7; subst. inversion H4; subst; inversion H7; subst.
unfold updEnv; simpl. unfold updEnv; simpl.
unfold updEnv in H6,H9; simpl in *. unfold updEnv in H1,H6; simpl in *.
symmetry in H6,H9. symmetry in H1,H6.
inversion H6; inversion H9; subst. inversion H1; inversion H6; subst.
(* We have now obtained all necessary values from the evaluations --> remove them for readability *) (* 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 H9. clear plus_float H4 H7 plus_real e1_real e1_float e2_real e2_float H8 H6 H1.
repeat rewrite Rmult_plus_distr_l. repeat rewrite Rmult_plus_distr_l.
rewrite Rmult_1_r. rewrite Rmult_1_r.
rewrite Rsub_eq_Ropp_Rplus. rewrite Rsub_eq_Ropp_Rplus.
...@@ -89,9 +89,9 @@ Proof. ...@@ -89,9 +89,9 @@ Proof.
eapply Rle_trans. eapply Rle_trans.
apply H. apply H.
pose proof (Rabs_triang (e2R + - e2F) (- ((e1F + e2F) * delta))). 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. eapply Rle_trans.
apply H1. apply H4.
rewrite <- Rplus_assoc. rewrite <- Rplus_assoc.
repeat rewrite <- Rsub_eq_Ropp_Rplus. repeat rewrite <- Rsub_eq_Ropp_Rplus.
rewrite Rabs_Ropp. rewrite Rabs_Ropp.
...@@ -109,13 +109,13 @@ Qed. ...@@ -109,13 +109,13 @@ Qed.
Copy-Paste proof with minor differences, was easier then manipulating the evaluations and then applying the lemma 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) 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 (m m1 m2:mType): (e2F:R) (vR:R) (vF:R) (E1 E2:env) err1 err2 (m m1 m2:mType) defVars:
eval_exp E1 (toREval (toRExp e1)) e1R M0 -> eval_exp E1 defVars (toREval (toRExp e1)) e1R M0 ->
eval_exp E2 (toRExp e1) e1F m1 -> eval_exp E2 defVars (toRExp e1) e1F m1 ->
eval_exp E1 (toREval (toRExp e2)) e2R M0 -> eval_exp E1 defVars (toREval (toRExp e2)) e2R M0 ->
eval_exp E2 (toRExp e2) e2F m2 -> eval_exp E2 defVars (toRExp e2) e2F m2 ->
eval_exp E1 (toREval (Binop Sub (toRExp e1) (toRExp e2))) vR M0 -> eval_exp E1 defVars (toREval (Binop Sub (toRExp e1) (toRExp e2))) vR M0 ->
eval_exp (updEnv 2 m2 e2F (updEnv 1 m1 e1F emptyEnv)) (Binop Sub (Var R m1 1) (Var R m2 2)) vF m -> eval_exp (updEnv 2 m2 e2F (updEnv 1 m1 e1F emptyEnv)) defVars (Binop Sub (Var R 1) (Var R 2)) vF m ->
(Rabs (e1R - e1F) <= Q2R err1)%R -> (Rabs (e1R - e1F) <= Q2R err1)%R ->
(Rabs (e2R - e2F) <= Q2R err2)%R -> (Rabs (e2R - e2F) <= Q2R err2)%R ->
(Rabs (vR - vF) <= Q2R err1 + Q2R err2 + ((Rabs (e1F - e2F)) * (Q2R (meps m))))%R. (Rabs (vR - vF) <= Q2R err1 + Q2R err2 + ((Rabs (e1F - e2F)) * (Q2R (meps m))))%R.
...@@ -139,11 +139,12 @@ Proof. ...@@ -139,11 +139,12 @@ Proof.
unfold perturb; simpl. unfold perturb; simpl.
inversion H4; subst; inversion H7; subst. inversion H4; subst; inversion H7; subst.
unfold updEnv; simpl. unfold updEnv; simpl.
symmetry in H6, H9. simpl in H0; simpl in H5; inversion H0; inversion H5; subst; clear H0 H5.
unfold updEnv in H6, H9; simpl in H6, H9. symmetry in H6, H1.
inversion H6; inversion H9; subst. 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 *) (* We have now obtained all necessary values from the evaluations --> remove them for readability *)
clear sub_float H4 H7 sub_real e1_real e1_float e2_real e2_float H6 H9 H8. clear sub_float H4 H7 sub_real e1_real e1_float e2_real e2_float H8 H1 H6.
repeat rewrite Rmult_plus_distr_l. repeat rewrite Rmult_plus_distr_l.
rewrite Rmult_1_r. rewrite Rmult_1_r.
repeat rewrite Rsub_eq_Ropp_Rplus. repeat rewrite Rsub_eq_Ropp_Rplus.
...@@ -167,13 +168,13 @@ Proof. ...@@ -167,13 +168,13 @@ Proof.
Qed. Qed.
Lemma mult_abs_err_bounded (e1:exp Q) (e1R:R) (e1F:R) (e2:exp Q) (e2R:R) (e2F:R) 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) (m m1 m2:mType): (vR:R) (vF:R) (E1 E2:env) (m m1 m2:mType) defVars:
eval_exp E1 (toREval (toRExp e1)) e1R M0 -> eval_exp E1 defVars (toREval (toRExp e1)) e1R M0 ->
eval_exp E2 (toRExp e1) e1F m1 -> eval_exp E2 defVars (toRExp e1) e1F m1 ->
eval_exp E1 (toREval (toRExp e2)) e2R M0 -> eval_exp E1 defVars (toREval (toRExp e2)) e2R M0 ->
eval_exp E2 (toRExp e2) e2F m2 -> eval_exp E2 defVars (toRExp e2) e2F m2 ->
eval_exp E1 (toREval (Binop Mult (toRExp e1) (toRExp e2))) vR M0 -> eval_exp E1 defVars (toREval (Binop Mult (toRExp e1) (toRExp e2))) vR M0 ->
eval_exp (updEnv 2 m2 e2F (updEnv 1 m1 e1F emptyEnv)) (Binop Mult (Var R m1 1) (Var R m2 2)) vF m-> eval_exp (updEnv 2 m2 e2F (updEnv 1 m1 e1F emptyEnv)) 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. (Rabs (vR - vF) <= Rabs (e1R * e2R - e1F * e2F) + Rabs (e1F * e2F) * (Q2R (meps m)))%R.
Proof. Proof.
intros e1_real e1_float e2_real e2_float mult_real mult_float. intros e1_real e1_float e2_real e2_float mult_real mult_float.
...@@ -195,9 +196,10 @@ Proof. ...@@ -195,9 +196,10 @@ Proof.
unfold perturb; simpl. unfold perturb; simpl.
inversion H3; subst; inversion H6; subst. inversion H3; subst; inversion H6; subst.
unfold updEnv in *; simpl in *. unfold updEnv in *; simpl in *.
inversion H5; inversion H8; 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 *) (* We have now obtained all necessary values from the evaluations --> remove them for readability *)
clear mult_float H7 H8 mult_real e1_real e1_float e2_real e2_float H5 H8. clear mult_float H7 mult_real e1_real e1_float e2_real e2_float H6 H1.
repeat rewrite Rmult_plus_distr_l. repeat rewrite Rmult_plus_distr_l.
rewrite Rmult_1_r. rewrite Rmult_1_r.
rewrite Rsub_eq_Ropp_Rplus. rewrite Rsub_eq_Ropp_Rplus.
...@@ -215,13 +217,13 @@ Proof. ...@@ -215,13 +217,13 @@ Proof.
Qed. Qed.
Lemma div_abs_err_bounded (e1:exp Q) (e1R:R) (e1F:R) (e2:exp Q) (e2R:R) (e2F:R) 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) (m m1 m2:mType): (vR:R) (vF:R) (E1 E2:env) (m m1 m2:mType) defVars:
eval_exp E1 (toREval (toRExp e1)) e1R M0 -> eval_exp E1 defVars (toREval (toRExp e1)) e1R M0 ->
eval_exp E2 (toRExp e1) e1F m1 -> eval_exp E2 defVars (toRExp e1) e1F m1 ->
eval_exp E1 (toREval (toRExp e2)) e2R M0 -> eval_exp E1 defVars (toREval (toRExp e2)) e2R M0 ->
eval_exp E2 (toRExp e2) e2F m2 -> eval_exp E2 defVars (toRExp e2) e2F m2 ->
eval_exp E1 (toREval (Binop Div (toRExp e1) (toRExp e2))) vR M0 -> eval_exp E1 defVars (toREval (Binop Div (toRExp e1) (toRExp e2))) vR M0 ->
eval_exp (updEnv 2 m2 e2F (updEnv 1 m1 e1F emptyEnv)) (Binop Div (Var R m1 1) (Var R m2 2)) vF m -> eval_exp (updEnv 2 m2 e2F (updEnv 1 m1 e1F emptyEnv)) 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. (Rabs (vR - vF) <= Rabs (e1R / e2R - e1F / e2F) + Rabs (e1F / e2F) * (Q2R (meps m)))%R.
Proof. Proof.
intros e1_real e1_float e2_real e2_float div_real div_float. intros e1_real e1_float e2_real e2_float div_real div_float.
...@@ -243,9 +245,9 @@ Proof. ...@@ -243,9 +245,9 @@ Proof.
unfold perturb; simpl. unfold perturb; simpl.
inversion H3; subst; inversion H9; subst. inversion H3; subst; inversion H9; subst.
unfold updEnv in *; simpl in *. unfold updEnv in *; simpl in *.
inversion H8; inversion H11; subst. inversion H8; inversion H1; subst.
(* We have now obtained all necessary values from the evaluations --> remove them for readability *) (* We have now obtained all necessary values from the evaluations --> remove them for readability *)
clear div_float H8 H11 div_real e1_real e1_float e2_real e2_float. clear div_float H0 H1 div_real e1_real e1_float e2_real e2_float.
repeat rewrite Rmult_plus_distr_l. repeat rewrite Rmult_plus_distr_l.
rewrite Rmult_1_r. rewrite Rmult_1_r.
rewrite Rsub_eq_Ropp_Rplus. rewrite Rsub_eq_Ropp_Rplus.
...@@ -440,10 +442,10 @@ Proof. ...@@ -440,10 +442,10 @@ Proof.
rewrite Q2R0_is_0; auto. rewrite Q2R0_is_0; auto.
Qed. Qed.
Lemma round_abs_err_bounded (e:exp R) (nR nF1 nF:R) (E1 E2: env) (err:R) (machineEpsilon m:mType): Lemma round_abs_err_bounded (e:exp R) (nR nF1 nF:R) (E1 E2: env) (err:R) (machineEpsilon m:mType) defVars:
eval_exp E1 (toREval e) nR M0 -> eval_exp E1 defVars (toREval e) nR M0 ->
eval_exp E2 e nF1 m -> eval_exp E2 defVars e nF1 m ->
eval_exp (updEnv 1 m nF1 emptyEnv) (toRExp (Downcast machineEpsilon (Var Q m 1))) nF machineEpsilon-> eval_exp (updEnv 1 m nF1 emptyEnv) defVars (toRExp (Downcast machineEpsilon (Var Q 1))) nF machineEpsilon->
(Rabs (nR - nF1) <= err)%R -> (Rabs (nR - nF1) <= err)%R ->
(Rabs (nR - nF) <= err + (Rabs nF1) * Q2R (meps machineEpsilon))%R. (Rabs (nR - nF) <= err + (Rabs nF1) * Q2R (meps machineEpsilon))%R.
Proof. Proof.
...@@ -456,8 +458,9 @@ Proof. ...@@ -456,8 +458,9 @@ Proof.
- apply Rplus_le_compat_l. - apply Rplus_le_compat_l.
inversion eval_float_rnd; subst. inversion eval_float_rnd; subst.
inversion H5; subst. inversion H5; subst.
inversion H7. inversion H0; subst.
unfold perturb; simpl. unfold perturb; simpl.
unfold updEnv in H3; simpl in H3; inversion H3; subst.
replace (v1 - v1 * (1 + delta))%R with (- (v1 * delta))%R by lra. replace (v1 - v1 * (1 + delta))%R with (- (v1 * delta))%R by lra.
replace (Rabs (-(v1*delta))) with (Rabs (v1*delta)) by (symmetry; apply Rabs_Ropp). replace (Rabs (-(v1*delta))) with (Rabs (v1*delta)) by (symmetry; apply Rabs_Ropp).
rewrite Rabs_mult. rewrite Rabs_mult.
......
...@@ -52,6 +52,12 @@ Definition unopEqBool (o1:unop) (o2:unop) := ...@@ -52,6 +52,12 @@ Definition unopEqBool (o1:unop) (o2:unop) :=
| _ , _ => false | _ , _ => false
end. end.
Lemma unopEqBool_refl b:
unopEqBool b b = true.
Proof.
case b; auto.
Qed.
(** (**
Define evaluation for unary operators on reals. Define evaluation for unary operators on reals.
Errors are added in the expression evaluation level later. Errors are added in the expression evaluation level later.
...@@ -69,7 +75,7 @@ Definition evalUnop (o:unop) (v:R):= ...@@ -69,7 +75,7 @@ Definition evalUnop (o:unop) (v:R):=
Will ease reasoning about different instantiations later. Will ease reasoning about different instantiations later.
**) **)
Inductive exp (V:Type): Type := Inductive exp (V:Type): Type :=
Var: mType -> nat -> exp V Var: nat -> exp V
| Const: mType -> V -> exp V | Const: mType -> V -> exp V
| Unop: unop -> exp V -> exp V | Unop: unop -> exp V -> exp V
| Binop: binop -> exp V -> exp V -> exp V | Binop: binop -> exp V -> exp V -> exp V
...@@ -81,7 +87,7 @@ Inductive exp (V:Type): Type := ...@@ -81,7 +87,7 @@ Inductive exp (V:Type): Type :=
**) **)
Fixpoint expEqBool (e1:exp Q) (e2:exp Q) := Fixpoint expEqBool (e1:exp Q) (e2:exp Q) :=
match e1, e2 with match e1, e2 with
| Var _ m1 v1, Var _ m2 v2 => andb (mTypeEqBool m1 m2) (v1 =? v2) | Var _ v1, Var _ v2 => (v1 =? v2)
| Const m1 n1, Const m2 n2 => andb (mTypeEqBool m1 m2) (Qeq_bool n1 n2) | Const m1 n1, Const m2 n2 => andb (mTypeEqBool m1 m2) (Qeq_bool n1 n2)
| Unop o1 e11, Unop o2 e22 => andb (unopEqBool o1 o2) (expEqBool e11 e22) | Unop o1 e11, Unop o2 e22 => andb (unopEqBool o1 o2) (expEqBool e11 e22)
| Binop o1 e11 e12, Binop o2 e21 e22 => andb (binopEqBool o1 o2) (andb (expEqBool e11 e21) (expEqBool e12 e22)) | Binop o1 e11 e12, Binop o2 e21 e22 => andb (binopEqBool o1 o2) (andb (expEqBool e11 e21) (expEqBool e12 e22))
...@@ -93,7 +99,7 @@ Fixpoint expEqBool (e1:exp Q) (e2:exp Q) := ...@@ -93,7 +99,7 @@ Fixpoint expEqBool (e1:exp Q) (e2:exp Q) :=
Lemma expEqBool_refl e: Lemma expEqBool_refl e:
expEqBool e e = true. expEqBool e e = true.
Proof. Proof.
induction e; apply andb_true_iff; split; simpl in *; auto; try (apply EquivEqBoolEq; auto). induction e; try (apply andb_true_iff; split); simpl in *; auto; try (apply EquivEqBoolEq; auto).
- symmetry; apply beq_nat_refl. - symmetry; apply beq_nat_refl.
- apply Qeq_bool_iff; lra. - apply Qeq_bool_iff; lra.
- case u; auto. - case u; auto.
...@@ -122,9 +128,7 @@ Lemma expEqBool_sym e e': ...@@ -122,9 +128,7 @@ Lemma expEqBool_sym e e':
Proof. Proof.
revert e'. revert e'.
induction e; intros e'; destruct e'; simpl; try auto. induction e; intros e'; destruct e'; simpl; try auto.
- f_equal. - apply beq_nat_sym.
+ apply mTypeEqBool_sym; auto.
+ apply beq_nat_sym.
- f_equal. - f_equal.
+ apply mTypeEqBool_sym; auto. + apply mTypeEqBool_sym; auto.
+ apply Qeq_bool_sym. + apply Qeq_bool_sym.
...@@ -146,13 +150,12 @@ Lemma expEqBool_trans e f g: ...@@ -146,13 +150,12 @@ Lemma expEqBool_trans e f g:
expEqBool f g = true -> expEqBool f g = true ->
expEqBool e g = true. expEqBool e g = true.
Proof. Proof.
revert e f g; induction e; destruct f; intros; simpl in H; inversion H; rewrite H; clear H; destruct g; simpl in H0; inversion H0; rewrite H0; clear H0; apply andb_true_iff in H1; destruct H1; apply andb_true_iff in H2; destruct H2; simpl. revert e f g; induction e; destruct f; intros; simpl in H; inversion H; rewrite H; clear H; destruct g; simpl in H0; inversion H0; rewrite H0; clear H0; try (apply andb_true_iff in H1; destruct H1; apply andb_true_iff in H2; destruct H2; simpl).
- apply EquivEqBoolEq in H1. - apply beq_nat_true in H2.
apply EquivEqBoolEq in H. apply beq_nat_true in H1.
apply beq_nat_true in H2.
apply beq_nat_true in H0.
subst. subst.
rewrite <- beq_nat_refl,mTypeEqBool_refl. unfold expEqBool.
rewrite <- beq_nat_refl.
auto. auto.
- apply EquivEqBoolEq in H1. - apply EquivEqBoolEq in H1.
apply EquivEqBoolEq in H. apply EquivEqBoolEq in H.
...@@ -186,7 +189,7 @@ Qed. ...@@ -186,7 +189,7 @@ Qed.
Fixpoint toRExp (e:exp Q) := Fixpoint toRExp (e:exp Q) :=
match e with match e with
|Var _ m v => Var R m v |Var _ v => Var R v
|Const m n => Const m (Q2R n) |Const m n => Const m (Q2R n)
|Unop o e1 => Unop o (toRExp e1) |Unop o e1 => Unop o (toRExp e1)
|Binop o e1 e2 => Binop o (toRExp e1) (toRExp e2) |Binop o e1 e2 => Binop o (toRExp e1) (toRExp e2)
...@@ -195,7 +198,7 @@ Fixpoint toRExp (e:exp Q) := ...@@ -195,7 +198,7 @@ Fixpoint toRExp (e:exp Q) :=
Fixpoint toREval (e:exp R) := Fixpoint toREval (e:exp R) :=
match e with match e with
| Var _ _ v => Var R M0 v | Var _ v => Var R v
| Const _ n => Const M0 n | Const _ n => Const M0 n
| Unop o e1 => Unop o (toREval e1) | Unop o e1 => Unop o (toREval e1)
| Binop o e1 e2 => Binop o (toREval e1) (toREval e2) | Binop o e1 e2 => Binop o (toREval e1) (toREval e2)
...@@ -223,32 +226,33 @@ The result value expresses float computations according to the IEEE standard, ...@@ -223,32 +226,33 @@ The result value expresses float computations according to the IEEE standard,
using a perturbation of the real valued computation by (1 + delta), where using a perturbation of the real valued computation by (1 + delta), where
|delta| <= machine epsilon. |delta| <= machine epsilon.
**) **)
Inductive eval_exp (E:env) :(exp R) -> R -> mType -> Prop := Inductive eval_exp (E:env) (defVars: nat -> option mType) :(exp R) -> R -> mType -> Prop :=
| Var_load m x v: | Var_load m x v:
defVars x = Some m ->
E x = Some (v, m) -> E x = Some (v, m) ->
eval_exp E (Var R m x) v m eval_exp E defVars (Var R x) v m
| Const_dist m n delta: | Const_dist m n delta:
Rle (Rabs delta) (Q2R (meps m)) -> Rle (Rabs delta) (Q2R (meps m)) ->
eval_exp E (Const m n) (perturb n delta) m eval_exp E defVars (Const m n) (perturb n delta) m
| Unop_neg m f1 v1: | Unop_neg m f1 v1:
eval_exp E f1 v1 m -> eval_exp E defVars f1 v1 m ->
eval_exp E (Unop Neg f1) (evalUnop Neg v1) m eval_exp E defVars (Unop Neg f1) (evalUnop Neg v1) m
| Unop_inv m f1 v1 delta: | Unop_inv m f1 v1 delta:
Rle (Rabs delta) (Q2R (meps m)) -> Rle (Rabs delta) (Q2R (meps m)) ->
eval_exp E f1 v1 m -> eval_exp E defVars f1 v1 m ->
eval_exp E (Unop Inv f1) (perturb (evalUnop Inv v1) delta) m eval_exp E defVars (Unop Inv f1) (perturb (evalUnop Inv v1) delta) m
| Binop_dist m1 m2 op f1 f2 v1 v2 delta: | Binop_dist m1 m2 op f1 f2 v1 v2 delta:
Rle (Rabs delta) (Q2R (meps (computeJoin m1 m2))) -> Rle (Rabs delta) (Q2R (meps (computeJoin m1 m2))) ->
eval_exp E f1 v1 m1 -> eval_exp E defVars f1 v1 m1 ->
eval_exp E f2 v2 m2 -> eval_exp E defVars f2 v2 m2 ->
((op = Div) -> (~ v2 = 0)%R) -> ((op = Div) -> (~ v2 = 0)%R) ->
eval_exp E (Binop op f1 f2) (perturb (evalBinop op v1 v2) delta) (computeJoin m1 m2) eval_exp E defVars (Binop op f1 f2) (perturb (evalBinop op v1 v2) delta) (computeJoin m1 m2)
| Downcast_dist m m1 f1 v1 delta: | Downcast_dist m m1 f1 v1 delta:
(* Downcast expression f1 (evaluating to machine type m1), to a machine type m, less precise than m1.*) (* Downcast expression f1 (evaluating to machine type m1), to a machine type m, less precise than m1.*)
isMorePrecise m1 m = true -> isMorePrecise m1 m = true ->
Rle (Rabs delta) (Q2R (meps m)) -> Rle (Rabs delta) (Q2R (meps m)) ->
eval_exp E f1 v1 m1 -> eval_exp E defVars f1 v1 m1 ->
eval_exp E (Downcast m f1) (perturb v1 delta) m. eval_exp E defVars (Downcast m f1) (perturb v1 delta) m.
(** (**
...@@ -257,7 +261,7 @@ Inductive eval_exp (E:env) :(exp R) -> R -> mType -> Prop := ...@@ -257,7 +261,7 @@ Inductive eval_exp (E:env) :(exp R) -> R -> mType -> Prop :=
**) **)
Fixpoint usedVars (V:Type) (e:exp V) :NatSet.t := Fixpoint usedVars (V:Type) (e:exp V) :NatSet.t :=
match e with match e with
| Var _ _ x => NatSet.singleton x | Var _ x => NatSet.singleton x
| Unop u e1 => usedVars e1 | Unop u e1 => usedVars e1
| Binop b e1 e2 => NatSet.union (usedVars e1) (usedVars e2) | Binop b e1 e2 => NatSet.union (usedVars e1) (usedVars e2)
| Downcast _ e1 => usedVars e1 | Downcast _ e1 => usedVars e1
...@@ -277,17 +281,17 @@ Proof. ...@@ -277,17 +281,17 @@ Proof.
Qed. Qed.
Lemma general_meps_0_deterministic (f:exp R) (E:env): Lemma general_meps_0_deterministic (f:exp R) (E:env) defVars:
forall v1 v2 m1, forall v1 v2 m1,
m1 = M0 -> m1 = M0 ->
eval_exp E (toREval f) v1 m1 -> eval_exp E defVars (toREval f) v1 m1 ->
eval_exp E (toREval f) v2 M0 -> eval_exp E defVars (toREval f) v2 M0 ->
v1 = v2. v1 = v2.
Proof. Proof.
induction f; intros v1 v2 m1 m10_eq eval_v1 eval_v2. induction f; intros * m10_eq eval_v1 eval_v2.
- inversion eval_v1; inversion eval_v2; subst; auto; - inversion eval_v1; inversion eval_v2; subst; auto;
try repeat (repeat rewrite delta_0_deterministic; simpl in *; rewrite Q2R0_is_0 in *; subst; auto); simpl. try repeat (repeat rewrite delta_0_deterministic; simpl in *; rewrite Q2R0_is_0 in *; subst; auto); simpl.
rewrite H7 in H3; inversion H3; subst; auto. rewrite H6 in H1; inversion H1; subst; auto.
- inversion eval_v1; inversion eval_v2; subst; auto; - inversion eval_v1; inversion eval_v2; subst; auto;
try repeat (repeat rewrite delta_0_deterministic; simpl in *; rewrite Q2R0_is_0 in *; subst; auto); simpl. try repeat (repeat rewrite delta_0_deterministic; simpl in *; rewrite Q2R0_is_0 in *; subst; auto); simpl.
- inversion eval_v1; inversion eval_v2; subst; auto; - inversion eval_v1; inversion eval_v2; subst; auto;
...@@ -324,10 +328,10 @@ Qed. ...@@ -324,10 +328,10 @@ Qed.
(** (**
Evaluation with 0 as machine epsilon is deterministic Evaluation with 0 as machine epsilon is deterministic
**) **)
Lemma meps_0_deterministic (f:exp R) (E:env): Lemma meps_0_deterministic (f:exp R) (E:env) defVars:
forall v1 v2, forall v1 v2,
eval_exp E (toREval f) v1 M0 -> eval_exp E defVars (toREval f) v1 M0 ->
eval_exp E (toREval f) v2 M0 -> eval_exp E defVars (toREval f) v2 M0 ->
v1 = v2. v1 = v2.
Proof. Proof.
intros v1 v2 ev1 ev2. intros v1 v2 ev1 ev2.
...@@ -342,31 +346,32 @@ For each evaluation of using an arbitrary epsilon, we can replace it by ...@@ -342,31 +346,32 @@ For each evaluation of using an arbitrary epsilon, we can replace it by
evaluating the subexpressions and then binding the result values to different evaluating the subexpressions and then binding the result values to different
variables in the Environment. variables in the Environment.
**) **)
Lemma binary_unfolding b f1 f2 m E vF: Lemma binary_unfolding b f1 f2 m E vF defVars:
eval_exp E (Binop b f1 f2) vF m -> eval_exp E defVars (Binop b f1 f2) vF m ->
exists vF1 vF2 m1 m2, exists vF1 vF2 m1 m2,
m = computeJoin m1 m2 /\ m = computeJoin m1 m2 /\
eval_exp E f1 vF1 m1 /\ eval_exp E defVars f1 vF1 m1 /\
eval_exp E f2 vF2 m2 /\ eval_exp E defVars f2 vF2 m2 /\
eval_exp (updEnv 2 m2 vF2 (updEnv 1 m1 vF1 emptyEnv)) eval_exp (updEnv 2 m2 vF2 (updEnv 1 m1 vF1 emptyEnv))
(Binop b (Var R m1 1) (Var R m2 2)) vF m. (fun n => if (n =? 2) then Some m2 else if (n =? 1) then Some m1 else defVars n)
(Binop b (Var R 1) (Var R 2)) vF m.
Proof. Proof.
intros eval_float. intros eval_float.
inversion eval_float; subst. inversion eval_float; subst.
exists v1 ; exists v2; exists m1; exists m2; repeat split; try auto. exists v1 ; exists v2; exists m1; exists m2; repeat split; try auto.