Commit 8c1d9348 authored by Heiko Becker's avatar Heiko Becker

Rework typing to get the semantics and typing work closer together.

Using this new typing, prove the stronger soundness statement, moving the evaluation to the conclusion of the theorems.
parent 0cc8a44b
...@@ -25,22 +25,25 @@ Definition CertificateChecker (e:exp Q) (absenv:analysisResult) (P:precond) (def ...@@ -25,22 +25,25 @@ Definition CertificateChecker (e:exp Q) (absenv:analysisResult) (P:precond) (def
the real valued execution respects the precondition. the real valued execution respects the precondition.
**) **)
Theorem Certificate_checking_is_sound (e:exp Q) (absenv:analysisResult) P defVars: Theorem Certificate_checking_is_sound (e:exp Q) (absenv:analysisResult) P defVars:
forall (E1 E2:env) (vR:R) (vF:R) fVars m, forall (E1 E2:env),
approxEnv E1 defVars absenv fVars NatSet.empty E2 -> approxEnv E1 defVars absenv (usedVars e) NatSet.empty E2 ->
(forall v, NatSet.mem v fVars = true -> (forall v, NatSet.mem v (Expressions.usedVars e) = true ->
exists vR, E1 v = Some vR /\ exists vR, E1 v = Some vR /\
(Q2R (fst (P v)) <= vR <= Q2R (snd (P v)))%R) -> (Q2R (fst (P v)) <= vR <= Q2R (snd (P v)))%R) ->
NatSet.Subset (Expressions.usedVars e) fVars -> (forall v, (v) mem (usedVars e) = true ->
eval_exp E1 (toREvalVars defVars) (toREval (toRExp e)) vR M0 -> exists m : mType,
eval_exp E2 defVars (toRExp e) vF m -> defVars v = Some m) ->
CertificateChecker e absenv P defVars = true -> CertificateChecker e absenv P defVars = true ->
exists vR vF m,
eval_exp E1 (toRMap defVars) (toREval (toRExp e)) vR M0 /\
eval_exp E2 defVars (toRExp e) vF m /\
(Rabs (vR - vF) <= Q2R (snd (absenv e)))%R. (Rabs (vR - vF) <= Q2R (snd (absenv e)))%R.
(** (**
The proofs is a simple composition of the soundness proofs for the range The proofs is a simple composition of the soundness proofs for the range
validator and the error bound validator. validator and the error bound validator.
**) **)
Proof. Proof.
intros * approxE1E2 P_valid fVars_subset eval_real eval_float certificate_valid. intros * approxE1E2 P_valid types_defined certificate_valid.
unfold CertificateChecker in certificate_valid. unfold CertificateChecker in certificate_valid.
rewrite <- andb_lazy_alt in certificate_valid. rewrite <- andb_lazy_alt in certificate_valid.
andb_to_prop certificate_valid. andb_to_prop certificate_valid.
...@@ -48,14 +51,23 @@ Proof. ...@@ -48,14 +51,23 @@ Proof.
destruct env_e as [iv [err absenv_eq]]. destruct env_e as [iv [err absenv_eq]].
destruct iv as [ivlo ivhi]. destruct iv as [ivlo ivhi].
rewrite absenv_eq; simpl. rewrite absenv_eq; simpl.
eapply validErrorbound_sound; eauto. pose proof (NatSetProps.empty_union_2 (Expressions.usedVars e) NatSet.empty_spec) as union_empty.
- hnf. intros a in_diff. hnf in union_empty.
rewrite NatSet.diff_spec in in_diff. assert (forall v1, (v1) mem (Expressions.usedVars e NatSet.empty) = true ->
apply fVars_subset. exists m0 : mType, defVars v1 = Some m0).
destruct in_diff; auto. { intros; eapply types_defined.
- intros v v_in_empty. rewrite NatSet.mem_spec in *.
rewrite <- union_empty; eauto. }
assert (NatSet.Subset (usedVars e -- NatSet.empty) (Expressions.usedVars e)).
{ hnf; intros a in_empty.
set_tac. }
assert (forall v, (v) mem (NatSet.empty) = true -> exists vR : R, E1 v = Some vR /\ (Q2R (fst (fst (absenv (Var Q v)))) <= vR <= Q2R (snd (fst (absenv (Var Q v)))))%R).
{ intros v v_in_empty.
rewrite NatSet.mem_spec in v_in_empty. rewrite NatSet.mem_spec in v_in_empty.
inversion v_in_empty. inversion v_in_empty. }
edestruct validIntervalbounds_sound as [vR [eval_real real_bounds_e]]; eauto.
destruct (validErrorbound_sound e P (typeMap defVars e) L approxE1E2 H0 eval_real R0 L0 H1 P_valid H absenv_eq) as [vF [mF [eval_float err_bounded]]]; auto.
exists vR; exists vF; exists mF; split; auto.
Qed. Qed.
Definition CertificateCheckerCmd (f:cmd Q) (absenv:analysisResult) (P:precond) defVars:= Definition CertificateCheckerCmd (f:cmd Q) (absenv:analysisResult) (P:precond) defVars:=
...@@ -66,21 +78,25 @@ Definition CertificateCheckerCmd (f:cmd Q) (absenv:analysisResult) (P:precond) d ...@@ -66,21 +78,25 @@ Definition CertificateCheckerCmd (f:cmd Q) (absenv:analysisResult) (P:precond) d
else false. else false.
Theorem Certificate_checking_cmds_is_sound (f:cmd Q) (absenv:analysisResult) P defVars: Theorem Certificate_checking_cmds_is_sound (f:cmd Q) (absenv:analysisResult) P defVars:
forall (E1 E2:env) vR vF m, forall (E1 E2:env),
approxEnv E1 defVars absenv (freeVars f) NatSet.empty E2 -> approxEnv E1 defVars absenv (freeVars f) NatSet.empty E2 ->
(forall v, NatSet.mem v (freeVars f)= true -> (forall v, NatSet.mem v (freeVars f)= true ->
exists vR, E1 v = Some vR /\ exists vR, E1 v = Some vR /\
(Q2R (fst (P v)) <= vR <= Q2R (snd (P v)))%R) -> (Q2R (fst (P v)) <= vR <= Q2R (snd (P v)))%R) ->
bstep (toREvalCmd (toRCmd f)) E1 (toREvalVars defVars) vR M0 -> (forall v, (v) mem (freeVars f) = true ->
bstep (toRCmd f) E2 defVars vF m -> exists m : mType,
defVars v = Some m) ->
CertificateCheckerCmd f absenv P defVars = true -> CertificateCheckerCmd f absenv P defVars = true ->
exists vR vF m,
bstep (toREvalCmd (toRCmd f)) E1 (toRMap defVars) vR M0 /\
bstep (toRCmd f) E2 defVars vF m /\
(Rabs (vR - vF) <= Q2R (snd (absenv (getRetExp f))))%R. (Rabs (vR - vF) <= Q2R (snd (absenv (getRetExp f))))%R.
(** (**
The proofs is a simple composition of the soundness proofs for the range The proofs is a simple composition of the soundness proofs for the range
validator and the error bound validator. validator and the error bound validator.
**) **)
Proof. Proof.
intros * approxE1E2 P_valid eval_real eval_float certificate_valid. intros * approxE1E2 P_valid types_defined certificate_valid.
unfold CertificateCheckerCmd in certificate_valid. unfold CertificateCheckerCmd in certificate_valid.
repeat rewrite <- andb_lazy_alt in certificate_valid. repeat rewrite <- andb_lazy_alt in certificate_valid.
andb_to_prop certificate_valid. andb_to_prop certificate_valid.
...@@ -89,20 +105,25 @@ Proof. ...@@ -89,20 +105,25 @@ Proof.
env_assert absenv (getRetExp f) env_f. env_assert absenv (getRetExp f) env_f.
destruct env_f as [iv [err absenv_eq]]. destruct env_f as [iv [err absenv_eq]].
destruct iv as [ivlo ivhi]. destruct iv as [ivlo ivhi].
assert (ssa f (freeVars f NatSet.empty) outVars) as ssa_valid.
{ eapply ssa_equal_set; try eauto.
apply NatSetProps.empty_union_2.
apply NatSet.empty_spec. }
assert (forall v, (v) mem (NatSet.empty) = true ->
exists vR : R,
E1 v = Some vR /\ (Q2R (fst (fst (absenv (Var Q v)))) <= vR <= Q2R (snd (fst (absenv (Var Q v)))))%R) as no_dVars_valid.
{ intros v v_in_empty.
set_tac. inversion v_in_empty. }
assert (forall v, (v) mem (freeVars f NatSet.empty) = true ->
exists m : mType, defVars v = Some m) as types_valid.
{ intros v v_mem; apply types_defined.
set_tac. rewrite NatSet.union_spec in v_mem.
destruct v_mem; try auto.
inversion H. }
assert (NatSet.Subset (freeVars f -- NatSet.empty) (freeVars f))
as freeVars_contained by set_tac.
edestruct (validIntervalboundsCmd_sound) as [vR [eval_real bounded_real_f]] ; eauto.
rewrite absenv_eq; simpl. rewrite absenv_eq; simpl.
eapply (validErrorboundCmd_sound); eauto. edestruct (validErrorboundCmd_sound) as [vF [mF [eval_float bounded_float]]]; eauto.
- instantiate (1 := outVars). exists vR; exists vF; exists mF; split; auto.
eapply ssa_equal_set; try eauto. Qed.
hnf. \ No newline at end of file
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
...@@ -51,16 +51,13 @@ Inductive sstep : cmd R -> env -> R -> cmd R -> env -> Prop := ...@@ -51,16 +51,13 @@ Inductive sstep : cmd R -> env -> R -> cmd R -> env -> Prop :=
**) **)
Inductive bstep : cmd R -> env -> (nat -> option mType) -> R -> mType -> Prop := Inductive bstep : cmd R -> env -> (nat -> option mType) -> R -> mType -> Prop :=
let_b m m' x e s E v res defVars: let_b m m' x e s E v res defVars:
eval_exp E defVars e v m -> eval_exp E defVars e v m ->
defVars x = Some m -> bstep s (updEnv x v E) (updDefVars x m defVars) res m' ->
bstep s (updEnv x v E) defVars res m' ->
bstep (Let m x e s) E defVars res m' bstep (Let m x e s) E defVars res m'
|ret_b m e E v defVars: |ret_b m e E v defVars:
eval_exp E defVars e v m -> eval_exp E defVars e v m ->
bstep (Ret e) E defVars v m. bstep (Ret e) E defVars v m.
(** (**
The free variables of a command are all used variables of expressions The free variables of a command are all used variables of expressions
without the let bound variables without the let bound variables
......
...@@ -17,15 +17,14 @@ Inductive approxEnv : env -> (nat -> option mType) -> analysisResult -> NatSet.t ...@@ -17,15 +17,14 @@ Inductive approxEnv : env -> (nat -> option mType) -> analysisResult -> NatSet.t
approxEnv emptyEnv defVars A NatSet.empty NatSet.empty emptyEnv approxEnv emptyEnv defVars A NatSet.empty NatSet.empty emptyEnv
|approxUpdFree E1 E2 defVars A v1 v2 x fVars dVars m: |approxUpdFree E1 E2 defVars A v1 v2 x fVars dVars m:
approxEnv E1 defVars A fVars dVars E2 -> approxEnv E1 defVars A fVars dVars E2 ->
defVars x = Some m -> (Rabs (v1 - v2) <= (Rabs v1) * Q2R (mTypeToQ m))%R ->
(Rabs (v1 - v2) <= (Rabs v1) * Q2R (meps m))%R ->
NatSet.mem x (NatSet.union fVars dVars) = false -> NatSet.mem x (NatSet.union fVars dVars) = false ->
approxEnv (updEnv x v1 E1) defVars A (NatSet.add x fVars) dVars (updEnv x v2 E2) approxEnv (updEnv x v1 E1) (updDefVars x m defVars) A (NatSet.add x fVars) dVars (updEnv x v2 E2)
|approxUpdBound E1 E2 defVars A v1 v2 x fVars dVars: |approxUpdBound E1 E2 defVars A v1 v2 x fVars dVars m:
approxEnv E1 defVars A fVars dVars E2 -> approxEnv E1 defVars A fVars dVars E2 ->
(Rabs (v1 - v2) <= Q2R (snd (A (Var Q 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 v1 E1) defVars A fVars (NatSet.add x dVars) (updEnv x v2 E2). approxEnv (updEnv x v1 E1) (updDefVars x m defVars) A fVars (NatSet.add x dVars) (updEnv x v2 E2).
(* Inductive approxParams :env -> env -> Prop := *) (* Inductive approxParams :env -> env -> Prop := *)
(* |approxParamRefl: *) (* |approxParamRefl: *)
...@@ -34,3 +33,110 @@ Inductive approxEnv : env -> (nat -> option mType) -> analysisResult -> NatSet.t ...@@ -34,3 +33,110 @@ Inductive approxEnv : env -> (nat -> option mType) -> analysisResult -> NatSet.t
(* approxParams E1 E2 -> *) (* approxParams E1 E2 -> *)
(* (Rabs (v1 - v2) <= Q2R (meps m))%R -> *) (* (Rabs (v1 - v2) <= Q2R (meps m))%R -> *)
(* approxParams (updEnv x M0 v1 E1) (updEnv x m v2 E2). *) (* approxParams (updEnv x M0 v1 E1) (updEnv x m v2 E2). *)
Section RelationProperties.
Variable (x:nat) (v:R) (E1 E2:env) (Gamma:nat -> option mType) (A:analysisResult) (fVars dVars: NatSet.t).
Hypothesis approxEnvs: approxEnv E1 Gamma A fVars dVars E2.
Lemma approxEnv_gives_value:
E1 x = Some v ->
NatSet.In x (NatSet.union fVars dVars) ->
exists v',
E2 x = Some v'.
Proof.
induction approxEnvs;
intros E1_def x_valid.
- unfold emptyEnv in E1_def; simpl in E1_def. congruence.
- unfold updEnv in *.
case_eq (x =? x0); intros eq_case; rewrite eq_case in *.
+ eexists; eauto.
+ eapply IHa; auto.
set_tac.
rewrite NatSet.union_spec in x_valid.
destruct x_valid; set_tac.
rewrite NatSet.add_spec in H1.
destruct H1; subst; try auto.
rewrite Nat.eqb_refl in eq_case; congruence.
- unfold updEnv in *.
case_eq (x =? x0); intros eq_case; rewrite eq_case in *.
+ eexists; eauto.
+ eapply IHa; auto.
set_tac.
rewrite NatSet.union_spec in x_valid.
destruct x_valid; set_tac.
rewrite NatSet.add_spec in H1.
destruct H1; subst; try auto.
rewrite Nat.eqb_refl in eq_case; congruence.
Qed.
Arguments mTypeToQ _ : simpl nomatch.
Lemma approxEnv_fVar_bounded v2 m:
E1 x = Some v ->
E2 x = Some v2 ->
NatSet.In x fVars ->
Gamma x = Some m ->
(Rabs (v - v2) <= (Rabs v) * Q2R (mTypeToQ m))%R.
Proof.
induction approxEnvs;
intros E1_def E2_def x_free x_typed.
- unfold emptyEnv in *; simpl in *; congruence.
- set_tac.
rewrite add_spec_strong in x_free.
destruct x_free as [x_x0 | [x_neq x_free]]; subst.
+ unfold updEnv in *;
rewrite Nat.eqb_refl in *; simpl in *.
unfold updDefVars in x_typed.
rewrite Nat.eqb_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.
- assert (x =? x0 = false) as x_x0_neq.
{ rewrite Nat.eqb_neq; hnf; intros; subst.
set_tac.
apply H0.
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.
Qed.
Lemma approxEnv_dVar_bounded v2 m:
E1 x = Some v ->
E2 x = Some v2 ->
NatSet.In x dVars ->
Gamma x = Some m ->
(Rabs (v - v2) <= Q2R (snd (A (Var Q x))))%R.
Proof.
induction approxEnvs;
intros E1_def E2_def x_def x_typed.
- unfold emptyEnv in *; simpl in *; congruence.
- assert (x =? x0 = false) as x_x0_neq.
{ rewrite Nat.eqb_neq; hnf; intros; subst.
set_tac.
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.
- set_tac.
rewrite add_spec_strong in x_def.
destruct x_def as [x_x0 | [x_neq x_def]]; subst.
+ unfold updEnv in *;
rewrite Nat.eqb_refl in *; simpl in *.
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.
Qed.
End RelationProperties.
\ No newline at end of file
...@@ -9,9 +9,9 @@ Require Import Daisy.Environments Daisy.Infra.ExpressionAbbrevs. ...@@ -9,9 +9,9 @@ Require Import Daisy.Environments Daisy.Infra.ExpressionAbbrevs.
Lemma const_abs_err_bounded (n:R) (nR:R) (nF:R) (E1 E2:env) (m:mType) defVars: 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 E1 (toRMap defVars) (Const M0 n) nR M0 ->
eval_exp E2 defVars (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 (mTypeToQ m)))%R.
Proof. Proof.
intros eval_real eval_float. intros eval_real eval_float.
inversion eval_real; subst. inversion eval_real; subst.
...@@ -20,24 +20,24 @@ Proof. ...@@ -20,24 +20,24 @@ Proof.
unfold perturb; simpl. unfold perturb; simpl.
rewrite Rabs_err_simpl, Rabs_mult. rewrite Rabs_err_simpl, Rabs_mult.
apply Rmult_le_compat_l; [apply Rabs_pos | auto]. apply Rmult_le_compat_l; [apply Rabs_pos | auto].
simpl (meps M0) in *. simpl (mTypeToQ M0) in *.
apply (Rle_trans _ (Q2R 0) _); try auto. apply (Rle_trans _ (Q2R 0) _); try auto.
rewrite Q2R0_is_0; lra. rewrite Q2R0_is_0; lra.
Qed. 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) defVars: (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 E1 (toRMap defVars) (toREval (toRExp e1)) e1R M0 ->
eval_exp E2 defVars (toRExp e1) e1F m1-> eval_exp E2 defVars (toRExp e1) e1F m1->
eval_exp E1 (toREvalVars defVars) (toREval (toRExp e2)) e2R M0 -> eval_exp E1 (toRMap defVars) (toREval (toRExp e2)) e2R M0 ->
eval_exp E2 defVars (toRExp e2) e2F m2 -> eval_exp E2 defVars (toRExp e2) e2F m2 ->
eval_exp E1 (toREvalVars defVars) (toREval (Binop Plus (toRExp e1) (toRExp e2))) vR M0 -> eval_exp E1 (toRMap defVars) (toREval (Binop Plus (toRExp e1) (toRExp e2))) vR M0 ->
eval_exp (updEnv 2 e2F (updEnv 1 e1F emptyEnv)) eval_exp (updEnv 2 e2F (updEnv 1 e1F emptyEnv))
(updDefVars 2 m2 (updDefVars 1 m1 defVars)) (updDefVars 2 m2 (updDefVars 1 m1 defVars))
(Binop Plus (Var R 1) (Var R 2)) vF m -> (Binop Plus (Var R 1) (Var R 2)) vF m ->
(Rabs (e1R - e1F) <= Q2R err1)%R -> (Rabs (e1R - e1F) <= Q2R err1)%R ->
(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 (mTypeToQ m))))%R.
Proof. Proof.
intros e1_real e1_float e2_real e2_float plus_real plus_float bound_e1 bound_e2. 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 *) (* Prove that e1R and e2R are the correct values and that vR is e1R + e2R *)
...@@ -94,17 +94,17 @@ Qed. ...@@ -94,17 +94,17 @@ Qed.
**) **)
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) defVars: (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 E1 (toRMap defVars) (toREval (toRExp e1)) e1R M0 ->
eval_exp E2 defVars (toRExp e1) e1F m1 -> eval_exp E2 defVars (toRExp e1) e1F m1 ->
eval_exp E1 (toREvalVars defVars) (toREval (toRExp e2)) e2R M0 -> eval_exp E1 (toRMap defVars) (toREval (toRExp e2)) e2R M0 ->
eval_exp E2 defVars (toRExp e2) e2F m2 -> eval_exp E2 defVars (toRExp e2) e2F m2 ->
eval_exp E1 (toREvalVars defVars) (toREval (Binop Sub (toRExp e1) (toRExp e2))) vR M0 -> eval_exp E1 (toRMap defVars) (toREval (Binop Sub (toRExp e1) (toRExp e2))) vR M0 ->
eval_exp (updEnv 2 e2F (updEnv 1 e1F emptyEnv)) eval_exp (updEnv 2 e2F (updEnv 1 e1F emptyEnv))
(updDefVars 2 m2 (updDefVars 1 m1 defVars)) (updDefVars 2 m2 (updDefVars 1 m1 defVars))
(Binop Sub (Var R 1) (Var R 2)) vF m -> (Binop Sub (Var R 1) (Var R 2)) vF m ->
(Rabs (e1R - e1F) <= Q2R err1)%R -> (Rabs (e1R - e1F) <= Q2R err1)%R ->
(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 (mTypeToQ m))))%R.
Proof. Proof.
intros e1_real e1_float e2_real e2_float sub_real sub_float bound_e1 bound_e2. 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 *) (* Prove that e1R and e2R are the correct values and that vR is e1R + e2R *)
...@@ -155,15 +155,15 @@ Qed. ...@@ -155,15 +155,15 @@ 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) defVars: (vR:R) (vF:R) (E1 E2:env) (m m1 m2:mType) defVars:
eval_exp E1 (toREvalVars defVars) (toREval (toRExp e1)) e1R M0 -> eval_exp E1 (toRMap defVars) (toREval (toRExp e1)) e1R M0 ->
eval_exp E2 defVars (toRExp e1) e1F m1 -> eval_exp E2 defVars (toRExp e1) e1F m1 ->
eval_exp E1 (toREvalVars defVars) (toREval (toRExp e2)) e2R M0 -> eval_exp E1 (toRMap defVars) (toREval (toRExp e2)) e2R M0 ->
eval_exp E2 defVars (toRExp e2) e2F m2 -> eval_exp E2 defVars (toRExp e2) e2F m2 ->
eval_exp E1 (toREvalVars defVars) (toREval (Binop Mult (toRExp e1) (toRExp e2))) vR M0 -> eval_exp E1 (toRMap defVars) (toREval (Binop Mult (toRExp e1) (toRExp e2))) vR M0 ->
eval_exp (updEnv 2 e2F (updEnv 1 e1F emptyEnv)) eval_exp (updEnv 2 e2F (updEnv 1 e1F emptyEnv))
(updDefVars 2 m2 (updDefVars 1 m1 defVars)) (updDefVars 2 m2 (updDefVars 1 m1 defVars))
(Binop Mult (Var R 1) (Var R 2)) vF m -> (Binop Mult (Var R 1) (Var R 2)) vF m ->
(Rabs (vR - vF) <= Rabs (e1R * e2R - e1F * e2F) + Rabs (e1F * e2F) * (Q2R (meps m)))%R. (Rabs (vR - vF) <= Rabs (e1R * e2R - e1F * e2F) + Rabs (e1F * e2F) * (Q2R (mTypeToQ 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.
(* Prove that e1R and e2R are the correct values and that vR is e1R * e2R *) (* Prove that e1R and e2R are the correct values and that vR is e1R * e2R *)
...@@ -206,15 +206,15 @@ Qed. ...@@ -206,15 +206,15 @@ 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) defVars: (vR:R) (vF:R) (E1 E2:env) (m m1 m2:mType) defVars:
eval_exp E1 (toREvalVars defVars) (toREval (toRExp e1)) e1R M0 -> eval_exp E1 (toRMap defVars) (toREval (toRExp e1)) e1R M0 ->
eval_exp E2 defVars (toRExp e1) e1F m1 -> eval_exp E2 defVars (toRExp e1) e1F m1 ->
eval_exp E1 (toREvalVars defVars) (toREval (toRExp e2)) e2R M0 -> eval_exp E1 (toRMap defVars) (toREval (toRExp e2)) e2R M0 ->
eval_exp E2 defVars (toRExp e2) e2F m2 -> eval_exp E2 defVars (toRExp e2) e2F m2 ->
eval_exp E1 (toREvalVars defVars) (toREval (Binop Div (toRExp e1) (toRExp e2))) vR M0 -> eval_exp E1 (toRMap defVars) (toREval (Binop Div (toRExp e1) (toRExp e2))) vR M0 ->
eval_exp (updEnv 2 e2F (updEnv 1 e1F emptyEnv)) eval_exp (updEnv 2 e2F (updEnv 1 e1F emptyEnv))
(updDefVars 2 m2 (updDefVars 1 m1 defVars)) (updDefVars 2 m2 (updDefVars 1 m1 defVars))
(Binop Div (Var R 1) (Var R 2)) vF m -> (Binop Div (Var R 1) (Var R 2)) vF m ->
(Rabs (vR - vF) <= Rabs (e1R / e2R - e1F / e2F) + Rabs (e1F / e2F) * (Q2R (meps m)))%R. (Rabs (vR - vF) <= Rabs (e1R / e2R - e1F / e2F) + Rabs (e1F / e2F) * (Q2R (mTypeToQ 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.
(* Prove that e1R and e2R are the correct values and that vR is e1R * e2R *) (* Prove that e1R and e2R are the correct values and that vR is e1R * e2R *)
...@@ -433,13 +433,13 @@ Proof. ...@@ -433,13 +433,13 @@ Proof.
Qed. Qed.
Lemma round_abs_err_bounded (e:exp R) (nR nF1 nF:R) (E1 E2: env) (err:R) (machineEpsilon m:mType) defVars: Lemma round_abs_err_bounded (e:exp R) (nR nF1 nF:R) (E1 E2: env) (err:R) (machineEpsilon m:mType) defVars:
eval_exp E1 (toREvalVars defVars) (toREval e) nR M0 -> eval_exp E1 (toRMap defVars) (toREval e) nR M0 ->
eval_exp E2 defVars e nF1 m -> eval_exp E2 defVars e nF1 m ->
eval_exp (updEnv 1 nF1 emptyEnv) eval_exp (updEnv 1 nF1 emptyEnv)
(updDefVars 1 m defVars) (updDefVars 1 m defVars)
(toRExp (Downcast machineEpsilon (Var Q 1))) nF machineEpsilon-> (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 (mTypeToQ machineEpsilon))%R.
Proof. Proof.
intros eval_real eval_float eval_float_rnd err_bounded. intros eval_real eval_float eval_float_rnd err_bounded.
replace (nR - nF)%R with ((nR - nF1) + (nF1 - nF))%R by lra. replace (nR - nF)%R with ((nR - nF1) + (nF1 - nF))%R by lra.
......
This diff is collapsed.
(** (**
Formalization of the base expression language for the daisy framework Formalization of the base expression language for the daisy framework
**) **)
Require Import Coq.Reals.Reals Coq.micromega.Psatz Coq.QArith.QArith Coq.QArith.Qreals. Require Import Coq.Reals.Reals Coq.micromega.Psatz Coq.QArith.QArith
Require Import Daisy.Infra.RealRationalProps Daisy.Infra.RationalSimps Daisy.Infra.Ltacs. Coq.QArith.Qreals.
Require Export Daisy.Infra.Abbrevs Daisy.Infra.RealSimps Daisy.Infra.NatSet Daisy.IntervalArithQ Daisy.IntervalArith Daisy.Infra.MachineType. Require Import Daisy.Infra.RealRationalProps Daisy.Infra.RationalSimps
Daisy.Infra.Ltacs.
Require Export Daisy.Infra.Abbrevs Daisy.Infra.RealSimps Daisy.Infra.NatSet
Daisy.IntervalArithQ Daisy.IntervalArith Daisy.Infra.MachineType.
(** (**
Expressions will use binary operators. Expressions will use binary operators.
...@@ -11,7 +14,7 @@ Require Export Daisy.Infra.Abbrevs Daisy.Infra.RealSimps Daisy.Infra.NatSet Dais ...@@ -11,7 +14,7 @@ Require Export Daisy.Infra.Abbrevs Daisy.Infra.RealSimps Daisy.Infra.NatSet Dais
**) **)
Inductive binop : Type := Plus | Sub | Mult | Div. Inductive binop : Type := Plus | Sub | Mult | Div.
Definition binopEqBool (b1:binop) (b2:binop) := Definition binopEq (b1:binop) (b2:binop) :=
match b1, b2 with match b1, b2 with
| Plus, Plus => true | Plus, Plus => true
| Sub, Sub => true | Sub, Sub => true
...@@ -32,16 +35,25 @@ Definition evalBinop (o:binop) (v1:R) (v2:R) := ...@@ -32,16 +35,25 @@ Definition evalBinop (o:binop) (v1:R) (v2:R) :=
| Div => Rdiv v1 v2 | Div => Rdiv v1 v2
end. end.
Lemma binopEqBool_refl b: Lemma binopEq_refl b:
binopEqBool b b = true. binopEq b b = true.
Proof. Proof.
case b; auto. case b; auto.
Qed. Qed.
Lemma binopEqBool_prop b1 b2: Lemma binopEq_compat_eq b1 b2:
binopEqBool b1 b2 = true <-> b1 = b2. binopEq b1 b2 = true <-> b1 = b2.
Proof.