Skip to content

GitLab

Commit 5607882d authored by ='s avatar =
Browse files
Options

Certificate checking Coq development is now finished?

parent e8c5b014
Show whitespace changes
Inline Side-by-side
Showing with 908 additions and 572 deletions
coq/CertificateChecker.v
View file @ 5607882d
......@@ -12,9 +12,11 @@ Require Export Coq.QArith.QArith.
Require Export Daisy.Infra.ExpressionAbbrevs Daisy.Commands.
(** Certificate checking function **)
Definition CertificateChecker (e:exp Q) (absenv:analysisResult) (P:precond) :=
Definition CertificateChecker (e:exp Q) (absenv:analysisResult) (P:precond) (defVars:nat -> option mType) :=
if (typeCheck e defVars (typeMap defVars e)) then
if (validIntervalbounds e absenv P NatSet.empty)
then (validErrorbound e (fun (e:exp Q) => typeExpression e) absenv NatSet.empty)
then (validErrorbound e (typeMap defVars e) absenv NatSet.empty)
else false
else false.
(**
......@@ -22,16 +24,16 @@ Definition CertificateChecker (e:exp Q) (absenv:analysisResult) (P:precond) :=
Apart from assuming two executions, one in R and one on floats, we assume that
the real valued execution respects the precondition.
**)
Theorem Certificate_checking_is_sound (e:exp Q) (absenv:analysisResult) P:
Theorem Certificate_checking_is_sound (e:exp Q) (absenv:analysisResult) P defVars:
forall (E1 E2:env) (vR:R) (vF:R) fVars m,
approxEnv E1 absenv fVars NatSet.empty E2 ->
approxEnv E1 defVars absenv fVars NatSet.empty E2 ->
(forall v, NatSet.mem v fVars = true ->
exists vR, E1 v = Some (vR, M0) /\
exists vR, E1 v = Some vR /\
(Q2R (fst (P v)) <= vR <= Q2R (snd (P v)))%R) ->
NatSet.Subset (Expressions.usedVars e) fVars ->
eval_exp E1 (toREval (toRExp e)) vR M0 ->
eval_exp E2 (toRExp e) vF m ->
CertificateChecker e absenv P = true ->
eval_exp E1 (toREvalVars defVars) (toREval (toRExp e)) vR M0 ->
eval_exp E2 defVars (toRExp e) vF m ->
CertificateChecker e absenv P defVars = true ->
(Rabs (vR - vF) <= Q2R (snd (absenv e)))%R.
(**
The proofs is a simple composition of the soundness proofs for the range
......@@ -47,33 +49,33 @@ Proof.
destruct iv as [ivlo ivhi].
rewrite absenv_eq; simpl.
eapply validErrorbound_sound; eauto.
- admit. (*eapply validTypeMap; eauto. *)
- hnf. intros a in_diff.
rewrite NatSet.diff_spec in in_diff.
apply fVars_subset.
destruct in_diff; auto.
- intros v m0 v_in_empty.
- intros v v_in_empty.
rewrite NatSet.mem_spec in v_in_empty.
inversion v_in_empty.
Admitted.
(* Qed. *)
Qed.
Definition CertificateCheckerCmd (f:cmd Q) (absenv:analysisResult) (P:precond) :=
if (validIntervalboundsCmd f absenv P NatSet.empty)
then (validErrorboundCmd f (fun e => typeExpression e) absenv NatSet.empty)
Definition CertificateCheckerCmd (f:cmd Q) (absenv:analysisResult) (P:precond) defVars:=
if (typeCheckCmd f defVars (typeMapCmd defVars f))
then if (validIntervalboundsCmd f absenv P NatSet.empty)
then (validErrorboundCmd f (typeMapCmd defVars f) absenv NatSet.empty)
else false
else false.
Theorem Certificate_checking_cmds_is_sound (f:cmd Q) (absenv:analysisResult) P:
Theorem Certificate_checking_cmds_is_sound (f:cmd Q) (absenv:analysisResult) P defVars:
forall (E1 E2:env) outVars vR vF fVars m,
approxEnv E1 absenv fVars NatSet.empty E2 ->
approxEnv E1 defVars absenv fVars NatSet.empty E2 ->
(forall v, NatSet.mem v fVars= true ->
exists vR, E1 v = Some (vR, M0) /\
exists vR, E1 v = Some vR /\
(Q2R (fst (P v)) <= vR <= Q2R (snd (P v)))%R) ->
NatSet.Subset (Commands.freeVars f) fVars ->
ssa f fVars outVars ->
bstep (toREvalCmd (toRCmd f)) E1 vR M0 ->
bstep (toRCmd f) E2 vF m ->
CertificateCheckerCmd f absenv P = true ->
bstep (toREvalCmd (toRCmd f)) E1 (toREvalVars defVars) vR M0 ->
bstep (toRCmd f) E2 defVars vF m ->
CertificateCheckerCmd f absenv P defVars = true ->
(Rabs (vR - vF) <= Q2R (snd (absenv (getRetExp f))))%R.
(**
The proofs is a simple composition of the soundness proofs for the range
......@@ -90,7 +92,6 @@ Proof.
destruct iv as [ivlo ivhi].
rewrite absenv_eq; simpl.
eapply (validErrorboundCmd_sound); eauto.
- admit. (* eapply typeMapCmdValid; eauto.*)
- instantiate (1 := outVars).
eapply ssa_equal_set; try eauto.
hnf.
......@@ -103,7 +104,7 @@ Proof.
rewrite NatSet.diff_spec in in_diff.
destruct in_diff.
apply fVars_subset; auto.
- intros v m1 v_in_empty.
- intros v v_in_empty.
rewrite NatSet.mem_spec in v_in_empty.
inversion v_in_empty.
Admitted.
\ No newline at end of file
Qed.
\ No newline at end of file
coq/Commands.v
View file @ 5607882d
......@@ -52,7 +52,8 @@ Inductive sstep : cmd R -> env -> R -> cmd R -> env -> Prop :=
Inductive bstep : cmd R -> env -> (nat -> option mType) -> R -> mType -> Prop :=
let_b m m' x e s E v res defVars:
eval_exp E defVars e v m ->
bstep s (updEnv x m v E) defVars res m' ->
defVars x = Some m ->
bstep s (updEnv x v E) defVars res m' ->
bstep (Let m x e s) E defVars res m'
|ret_b m e E v defVars:
eval_exp E defVars e v m ->
......
coq/Environments.v
View file @ 5607882d
......@@ -12,24 +12,25 @@ It is necessary to have this relation, since two evaluations of the very same
expression may yield different values for different machine epsilons
(or environments that already only approximate each other)
**)
Inductive approxEnv : env -> analysisResult -> NatSet.t -> NatSet.t -> env -> Prop :=
Inductive approxEnv : env -> (nat -> option mType) -> 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 m:
approxEnv E1 A fVars dVars E2 ->
approxEnv emptyEnv (fun n => None) A NatSet.empty NatSet.empty emptyEnv
|approxUpdFree E1 E2 defVars A v1 v2 x fVars dVars m:
approxEnv E1 defVars A fVars dVars E2 ->
defVars x = Some m ->
(Rabs (v1 - v2) <= (Rabs v1) * Q2R (meps m))%R ->
NatSet.mem x (NatSet.union fVars dVars) = false ->
approxEnv (updEnv x M0 v1 E1) A (NatSet.add x fVars) dVars (updEnv x m v2 E2)
|approxUpdBound E1 E2 A v1 v2 x fVars dVars m:
approxEnv E1 A fVars dVars E2 ->
approxEnv (updEnv x v1 E1) defVars A (NatSet.add x fVars) dVars (updEnv x v2 E2)
|approxUpdBound E1 E2 defVars A v1 v2 x fVars dVars:
approxEnv E1 defVars A fVars dVars E2 ->
(Rabs (v1 - v2) <= Q2R (snd (A (Var Q x))))%R ->
NatSet.mem x (NatSet.union fVars dVars) = false ->
approxEnv (updEnv x M0 v1 E1) A fVars (NatSet.add x dVars) (updEnv x m v2 E2).
approxEnv (updEnv x v1 E1) defVars A fVars (NatSet.add x dVars) (updEnv x v2 E2).
Inductive approxParams :env -> env -> Prop :=
|approxParamRefl:
approxParams emptyEnv emptyEnv
|approxParamUpd E1 E2 m x v1 v2 :
approxParams E1 E2 ->
(Rabs (v1 - v2) <= Q2R (meps m))%R ->
approxParams (updEnv x M0 v1 E1) (updEnv x m v2 E2).
(* Inductive approxParams :env -> env -> Prop := *)
(* |approxParamRefl: *)
(* approxParams emptyEnv emptyEnv *)
(* |approxParamUpd E1 E2 m x v1 v2 : *)
(* approxParams E1 E2 -> *)
(* (Rabs (v1 - v2) <= Q2R (meps m))%R -> *)
(* approxParams (updEnv x M0 v1 E1) (updEnv x m v2 E2). *)
coq/ErrorBounds.v
View file @ 5607882d
......@@ -8,7 +8,7 @@ Require Import Daisy.Infra.Abbrevs Daisy.Infra.RationalSimps Daisy.Infra.RealSim
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) defVars:
eval_exp E1 defVars (Const M0 n) nR M0 ->
eval_exp E1 (toREvalVars defVars) (Const M0 n) nR M0 ->
eval_exp E2 defVars (Const m n) nF m ->
(Rabs (nR - nF) <= Rabs n * (Q2R (meps m)))%R.
Proof.
......@@ -45,12 +45,12 @@ Qed.
Lemma add_abs_err_bounded (e1:exp Q) (e1R:R) (e1F:R) (e2:exp Q) (e2R:R) (e2F:R)
(vR:R) (vF:R) (E1 E2:env) (err1 err2 :Q) (m m1 m2:mType) defVars:
eval_exp E1 defVars (toREval (toRExp e1)) e1R M0 ->
eval_exp E1 (toREvalVars defVars) (toREval (toRExp e1)) e1R M0 ->
eval_exp E2 defVars (toRExp e1) e1F m1->
eval_exp E1 defVars (toREval (toRExp e2)) e2R M0 ->
eval_exp E1 (toREvalVars defVars) (toREval (toRExp e2)) e2R M0 ->
eval_exp E2 defVars (toRExp e2) e2F m2 ->
eval_exp E1 defVars (toREval (Binop Plus (toRExp e1) (toRExp e2))) vR M0 ->
eval_exp (updEnv 2 m2 e2F (updEnv 1 m1 e1F emptyEnv)) defVars (Binop Plus (Var R 1) (Var R 2)) vF m->
eval_exp E1 (toREvalVars defVars) (toREval (Binop Plus (toRExp e1) (toRExp e2))) vR M0 ->
eval_exp (updEnv 2 e2F (updEnv 1 e1F emptyEnv)) (fun n => if (n =? 2) then Some m2 else if (n =? 1) then Some m1 else defVars n) (Binop Plus (Var R 1) (Var R 2)) vF m->
(Rabs (e1R - e1F) <= Q2R err1)%R ->
(Rabs (e2R - e2F) <= Q2R err2)%R ->
(Rabs (vR - vF) <= Q2R err1 + Q2R err2 + (Rabs (e1F + e2F) * (Q2R (meps m))))%R.
......@@ -110,12 +110,12 @@ Qed.
**)
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:
eval_exp E1 defVars (toREval (toRExp e1)) e1R M0 ->
eval_exp E1 (toREvalVars defVars) (toREval (toRExp e1)) e1R M0 ->
eval_exp E2 defVars (toRExp e1) e1F m1 ->
eval_exp E1 defVars (toREval (toRExp e2)) e2R M0 ->
eval_exp E1 (toREvalVars defVars) (toREval (toRExp e2)) e2R M0 ->
eval_exp E2 defVars (toRExp e2) e2F m2 ->
eval_exp E1 defVars (toREval (Binop Sub (toRExp e1) (toRExp e2))) vR M0 ->
eval_exp (updEnv 2 m2 e2F (updEnv 1 m1 e1F emptyEnv)) defVars (Binop Sub (Var R 1) (Var R 2)) vF m ->
eval_exp E1 (toREvalVars defVars) (toREval (Binop Sub (toRExp e1) (toRExp e2))) vR M0 ->
eval_exp (updEnv 2 e2F (updEnv 1 e1F emptyEnv)) (fun n => if (n =? 2) then Some m2 else if (n =? 1) then Some m1 else defVars n) (Binop Sub (Var R 1) (Var R 2)) vF m ->
(Rabs (e1R - e1F) <= Q2R err1)%R ->
(Rabs (e2R - e2F) <= Q2R err2)%R ->
(Rabs (vR - vF) <= Q2R err1 + Q2R err2 + ((Rabs (e1F - e2F)) * (Q2R (meps m))))%R.
......@@ -169,12 +169,12 @@ Qed.
Lemma mult_abs_err_bounded (e1:exp Q) (e1R:R) (e1F:R) (e2:exp Q) (e2R:R) (e2F:R)
(vR:R) (vF:R) (E1 E2:env) (m m1 m2:mType) defVars:
eval_exp E1 defVars (toREval (toRExp e1)) e1R M0 ->
eval_exp E1 (toREvalVars defVars) (toREval (toRExp e1)) e1R M0 ->
eval_exp E2 defVars (toRExp e1) e1F m1 ->
eval_exp E1 defVars (toREval (toRExp e2)) e2R M0 ->
eval_exp E1 (toREvalVars defVars) (toREval (toRExp e2)) e2R M0 ->
eval_exp E2 defVars (toRExp e2) e2F m2 ->
eval_exp E1 defVars (toREval (Binop Mult (toRExp e1) (toRExp e2))) vR M0 ->
eval_exp (updEnv 2 m2 e2F (updEnv 1 m1 e1F emptyEnv)) defVars (Binop Mult (Var R 1) (Var R 2)) vF m->
eval_exp E1 (toREvalVars defVars) (toREval (Binop Mult (toRExp e1) (toRExp e2))) vR M0 ->
eval_exp (updEnv 2 e2F (updEnv 1 e1F emptyEnv)) (fun n => if (n =? 2) then Some m2 else if (n =? 1) then Some m1 else defVars n) (Binop Mult (Var R 1) (Var R 2)) vF m->
(Rabs (vR - vF) <= Rabs (e1R * e2R - e1F * e2F) + Rabs (e1F * e2F) * (Q2R (meps m)))%R.
Proof.
intros e1_real e1_float e2_real e2_float mult_real mult_float.
......@@ -218,12 +218,12 @@ Qed.
Lemma div_abs_err_bounded (e1:exp Q) (e1R:R) (e1F:R) (e2:exp Q) (e2R:R) (e2F:R)
(vR:R) (vF:R) (E1 E2:env) (m m1 m2:mType) defVars:
eval_exp E1 defVars (toREval (toRExp e1)) e1R M0 ->
eval_exp E1 (toREvalVars defVars) (toREval (toRExp e1)) e1R M0 ->
eval_exp E2 defVars (toRExp e1) e1F m1 ->
eval_exp E1 defVars (toREval (toRExp e2)) e2R M0 ->
eval_exp E1 (toREvalVars defVars) (toREval (toRExp e2)) e2R M0 ->
eval_exp E2 defVars (toRExp e2) e2F m2 ->
eval_exp E1 defVars (toREval (Binop Div (toRExp e1) (toRExp e2))) vR M0 ->
eval_exp (updEnv 2 m2 e2F (updEnv 1 m1 e1F emptyEnv)) defVars (Binop Div (Var R 1) (Var R 2)) vF m ->
eval_exp E1 (toREvalVars defVars) (toREval (Binop Div (toRExp e1) (toRExp e2))) vR M0 ->
eval_exp (updEnv 2 e2F (updEnv 1 e1F emptyEnv)) (fun n => if (n =? 2) then Some m2 else if (n =? 1) then Some m1 else defVars n) (Binop Div (Var R 1) (Var R 2)) vF m ->
(Rabs (vR - vF) <= Rabs (e1R / e2R - e1F / e2F) + Rabs (e1F / e2F) * (Q2R (meps m)))%R.
Proof.
intros e1_real e1_float e2_real e2_float div_real div_float.
......@@ -443,9 +443,9 @@ Proof.
Qed.
Lemma round_abs_err_bounded (e:exp R) (nR nF1 nF:R) (E1 E2: env) (err:R) (machineEpsilon m:mType) defVars:
eval_exp E1 defVars (toREval e) nR M0 ->
eval_exp E1 (toREvalVars defVars) (toREval e) nR M0 ->
eval_exp E2 defVars e nF1 m ->
eval_exp (updEnv 1 m nF1 emptyEnv) defVars (toRExp (Downcast machineEpsilon (Var Q 1))) nF machineEpsilon->
eval_exp (updEnv 1 nF1 emptyEnv) (fun n => if n =? 1 then Some m else defVars n) (toRExp (Downcast machineEpsilon (Var Q 1))) nF machineEpsilon->
(Rabs (nR - nF1) <= err)%R ->
(Rabs (nR - nF) <= err + (Rabs nF1) * Q2R (meps machineEpsilon))%R.
Proof.
......
coq/ErrorValidation.v
View file @ 5607882d
......@@ -109,28 +109,28 @@ Qed.
Lemma validErrorboundCorrectVariable:
forall E1 E2 absenv (v:nat) nR nF e nlo nhi P fVars dVars m Gamma defVars,
typeCheck (Var Q v) defVars Gamma = true ->
approxEnv E1 absenv fVars dVars E2 ->
eval_exp E1 defVars (toREval (toRExp (Var Q v))) nR M0 ->
approxEnv E1 defVars absenv fVars dVars E2 ->
eval_exp E1 (toREvalVars defVars) (toREval (toRExp (Var Q v))) nR M0 ->
eval_exp E2 defVars (toRExp (Var Q v)) nF m ->
validIntervalbounds (Var Q v) absenv P dVars = true ->
validErrorbound (Var Q v) Gamma absenv dVars = true ->
(forall v1,
NatSet.mem v1 dVars = true ->
exists r, E1 v1 = Some (r, M0) /\
exists r, E1 v1 = Some r /\
(Q2R (fst (fst (absenv (Var Q v1)))) <= r <= Q2R (snd (fst (absenv (Var Q v1)))))%R) ->
(forall v1, NatSet.mem v1 fVars= true ->
exists r, E1 v1 = Some (r, M0) /\
exists r, E1 v1 = Some r /\
(Q2R (fst (P v1)) <= r <= Q2R (snd (P v1)))%R) ->
absenv (Var Q v) = ((nlo, nhi), e) ->
(Rabs (nR - nF) <= (Q2R e))%R.
Proof.
intros * typing_ok approxCEnv eval_real eval_float bounds_valid error_valid dVars_sound P_valid absenv_var.
simpl in eval_real; inversion eval_real; inversion eval_float; subst.
rename H2 into E1_v;
rename H7 into E2_v.
rename H1 into E1_v;
rename H6 into E2_v.
simpl in error_valid.
rewrite absenv_var in error_valid; simpl in error_valid; subst.
case_eq (Gamma (Var Q m v)); intros; rewrite H in error_valid; [ | inversion error_valid].
case_eq (Gamma (Var Q v)); intros; rewrite H in error_valid; [ | inversion error_valid].
rewrite <- andb_lazy_alt in error_valid.
andb_to_prop error_valid.
rename L into error_pos.
......@@ -159,17 +159,17 @@ Proof.
apply Qle_Rle in error_valid.
eapply Rle_trans; eauto.
rewrite Q2R_mult.
inversion typing_ok; subst.
rewrite H in H5; inversion H5; subst.
rewrite H5 in H1; inversion H1; subst.
rewrite H,H5 in typing_ok; apply EquivEqBoolEq in typing_ok; subst.
clear H5 H3.
apply Rmult_le_compat_r.
{ apply inj_eps_posR. }
{ rewrite <- maxAbs_impl_RmaxAbs.
apply contained_leq_maxAbs.
unfold contained; simpl.
assert ((toRExp (Var Q m x)) = Var R m x) by (simpl; auto).
rewrite <- H2 in eval_float.
pose proof (validIntervalbounds_sound A P (E:=fun y : nat => if y =? x then Some (nR, M0) else E1 y) (vR:=nR) typing_ok bounds_valid (fVars := (NatSet.add x fVars))) as valid_bounds_prf.
assert ((toRExp (Var Q x)) = Var R x) by (simpl; auto).
rewrite <- H3 in eval_float.
pose proof (validIntervalbounds_sound (Var Q x) A P (E:=fun y : nat => if y =? x then Some nR else E1 y) (vR:=nR) defVars bounds_valid (fVars := (NatSet.add x fVars))) as valid_bounds_prf.
rewrite absenv_var in valid_bounds_prf; simpl in valid_bounds_prf.
apply valid_bounds_prf; try auto.
- intros v v_mem_diff.
......@@ -180,9 +180,9 @@ Proof.
+ apply IHapproxCEnv; try auto.
* constructor; auto.
* constructor; auto.
* intros v0 m2 mem_dVars.
specialize (dVars_sound v0 m2 mem_dVars).
destruct dVars_sound as [vR0 [mR0 iv_sound_val]].
* intros v0 mem_dVars.
specialize (dVars_sound v0 mem_dVars).
destruct dVars_sound as [vR0 iv_sound_val].
case_eq (v0 =? x); intros case_mem;
rewrite case_mem in iv_sound_val; simpl in iv_sound_val.
{ rewrite Nat.eqb_eq in case_mem; subst.
......@@ -191,7 +191,7 @@ Proof.
as x_in_union by (rewrite NatSet.union_spec; auto).
rewrite <- NatSet.mem_spec in x_in_union;
rewrite x_in_union in *; congruence. }
{ exists vR0, mR0; split; auto; destruct iv_sound_val as [E1_v0 iv_sound_val]; auto. }
{ exists vR0. split; auto; destruct iv_sound_val as [E1_v0 iv_sound_val]; auto. }
* intros v0 v0_fVar.
assert (NatSet.mem v0 (NatSet.add x fVars) = true)
as v0_in_add by (rewrite NatSet.mem_spec, NatSet.add_spec; rewrite NatSet.mem_spec in v0_fVar; auto).
......@@ -237,16 +237,16 @@ Proof.
+ rewrite <- NatSet.mem_spec in v_dVar. rewrite v_dVar in case_dVars.
inversion case_dVars. }
{ rewrite not_in_add in error_valid; auto. }
* intros v0 m2 mem_dVars.
specialize (dVars_sound v0 m2).
* intros v0 mem_dVars.
specialize (dVars_sound v0).
rewrite absenv_var in *; simpl in *.
rewrite NatSet.mem_spec in mem_dVars.
assert (NatSet.In v0 (NatSet.add x dVars)) as v0_in_add.
{ rewrite NatSet.add_spec. right; auto. }
{ rewrite <- NatSet.mem_spec in v0_in_add.
specialize (dVars_sound v0_in_add).
destruct dVars_sound as [vR0 [mR0 [val_def iv_sound_val]]].
exists vR0, mR0; split; auto.
destruct dVars_sound as [vR0 [val_def iv_sound_val]].
exists vR0; split; auto.
unfold updEnv in val_def; simpl in val_def.
case_eq (v0 =? x); intros case_mem;
rewrite case_mem in val_def; simpl in val_def.
......@@ -268,10 +268,10 @@ Proof.
Qed.
Lemma validErrorboundCorrectConstant:
forall E1 E2 absenv (n:Q) nR nF e nlo nhi dVars m Gamma,
eval_exp E1 (toREval (toRExp (Const m n))) nR M0 ->
eval_exp E2 (toRExp (Const m n)) nF m ->
validType Gamma (Const m n) m ->
forall E1 E2 absenv (n:Q) nR nF e nlo nhi dVars m Gamma defVars,
eval_exp E1 (toREvalVars defVars) (toREval (toRExp (Const m n))) nR M0 ->
eval_exp E2 defVars (toRExp (Const m n)) nF m ->
typeCheck (Const m n) defVars Gamma = true ->
validErrorbound (Const m n) Gamma absenv dVars = true ->
(Q2R nlo <= nR <= Q2R nhi)%R ->
absenv (Const m n) = ((nlo,nhi),e) ->
......@@ -299,20 +299,22 @@ Proof.
- rewrite Q2R_mult in error_valid.
rewrite <- maxAbs_impl_RmaxAbs in error_valid; auto.
inversion subexpr_ok; subst.
rewrite H in H6; inversion H6; subst; auto.
rewrite H in H4. apply EquivEqBoolEq in H4; subst; auto.
Qed.
Lemma validErrorboundCorrectAddition E1 E2 absenv
(e1:exp Q) (e2:exp Q) (nR nR1 nR2 nF nF1 nF2 :R) (e err1 err2 :error)
(alo ahi e1lo e1hi e2lo e2hi:Q) dVars m m1 m2 Gamma:
(alo ahi e1lo e1hi e2lo e2hi:Q) dVars m m1 m2 Gamma defVars:
m = computeJoin m1 m2 ->
eval_exp E1 (toREval (toRExp e1)) nR1 M0 ->
eval_exp E1 (toREval (toRExp e2)) nR2 M0 ->
eval_exp E1 (toREval (toRExp (Binop Plus e1 e2))) nR M0 ->
eval_exp E2 (toRExp e1) nF1 m1 ->
eval_exp E2 (toRExp e2) nF2 m2 ->
eval_exp (updEnv 2 m2 nF2 (updEnv 1 m1 nF1 emptyEnv)) (toRExp (Binop Plus (Var Q m1 1) (Var Q m2 2))) nF m ->
validType Gamma (Binop Plus e1 e2) m ->
eval_exp E1 (toREvalVars defVars) (toREval (toRExp e1)) nR1 M0 ->
eval_exp E1 (toREvalVars defVars) (toREval (toRExp e2)) nR2 M0 ->
eval_exp E1 (toREvalVars defVars) (toREval (toRExp (Binop Plus e1 e2))) nR M0 ->
eval_exp E2 defVars (toRExp e1) nF1 m1 ->
eval_exp E2 defVars (toRExp e2) nF2 m2 ->
eval_exp (updEnv 2 nF2 (updEnv 1 nF1 emptyEnv))
(fun n => if (n =? 2) then Some m2 else if (n =? 1) then Some m1 else defVars n)
(toRExp (Binop Plus (Var Q 1) (Var Q 2))) nF m ->
typeCheck (Binop Plus e1 e2) defVars Gamma = true ->
validErrorbound (Binop Plus e1 e2) Gamma absenv dVars = true ->
(Q2R e1lo <= nR1 <= Q2R e1hi)%R ->
(Q2R e2lo <= nR2 <= Q2R e2hi)%R ->
......@@ -333,9 +335,17 @@ Proof.
unfold validErrorbound in valid_error.
rewrite absenv_add,absenv_e1,absenv_e2 in valid_error.
case_eq (Gamma (Binop Plus e1 e2)); intros; rewrite H in valid_error; [ | inversion valid_error ].
inversion subexpr_ok; subst. rewrite H in H7; inversion H7; subst. clear m4 m5 H3 H4 H7 H6.
simpl in subexpr_ok; rewrite H in subexpr_ok.
case_eq (Gamma e1); intros; rewrite H0 in subexpr_ok; [ | inversion subexpr_ok ].
case_eq (Gamma e2); intros; rewrite H1 in subexpr_ok; [ | inversion subexpr_ok ].
andb_to_prop subexpr_ok.
apply EquivEqBoolEq in L0; subst.
pose proof (typingSoundnessExp _ _ R0 e1_float).
pose proof (typingSoundnessExp _ _ R e2_float).
rewrite H0 in H2; rewrite H1 in H3; inversion H2; inversion H3; subst.
clear H2 H3 H0 H1.
andb_to_prop valid_error.
rename R0 into valid_error.
rename R2 into valid_error.
eapply Rle_trans.
apply Rplus_le_compat_l.
eapply Rmult_le_compat_r.
......@@ -378,15 +388,17 @@ Qed.
Lemma validErrorboundCorrectSubtraction E1 E2 absenv
(e1:exp Q) (e2:exp Q) (nR nR1 nR2 nF nF1 nF2 :R) (e err1 err2 :error)
(alo ahi e1lo e1hi e2lo e2hi:Q) dVars (m m1 m2:mType) Gamma:
(alo ahi e1lo e1hi e2lo e2hi:Q) dVars (m m1 m2:mType) Gamma defVars:
m = computeJoin m1 m2 ->
eval_exp E1 (toREval (toRExp e1)) nR1 M0 ->
eval_exp E1 (toREval (toRExp e2)) nR2 M0 ->
eval_exp E1 (toREval (toRExp (Binop Sub e1 e2))) nR M0 ->
eval_exp E2 (toRExp e1) nF1 m1->
eval_exp E2 (toRExp e2) nF2 m2 ->
eval_exp (updEnv 2 m2 nF2 (updEnv 1 m1 nF1 emptyEnv)) (toRExp (Binop Sub (Var Q m1 1) (Var Q m2 2))) nF m ->
validType Gamma (Binop Sub e1 e2) m ->
eval_exp E1 (toREvalVars defVars) (toREval (toRExp e1)) nR1 M0 ->
eval_exp E1 (toREvalVars defVars) (toREval (toRExp e2)) nR2 M0 ->
eval_exp E1 (toREvalVars defVars) (toREval (toRExp (Binop Sub e1 e2))) nR M0 ->
eval_exp E2 defVars (toRExp e1) nF1 m1->
eval_exp E2 defVars (toRExp e2) nF2 m2 ->
eval_exp (updEnv 2 nF2 (updEnv 1 nF1 emptyEnv))
(fun n => if (n =? 2) then Some m2 else if (n =? 1) then Some m1 else defVars n)
(toRExp (Binop Sub (Var Q 1) (Var Q 2))) nF m ->
typeCheck (Binop Sub e1 e2) defVars Gamma = true ->
validErrorbound (Binop Sub e1 e2) Gamma absenv dVars = true ->
(Q2R e1lo <= nR1 <= Q2R e1hi)%R ->
(Q2R e2lo <= nR2 <= Q2R e2hi)%R ->
......@@ -405,9 +417,17 @@ Proof.
unfold validErrorbound in valid_error.
rewrite absenv_sub,absenv_e1,absenv_e2 in valid_error.
case_eq (Gamma (Binop Sub e1 e2)); intros; rewrite H in valid_error; [ | inversion valid_error ].
inversion subexpr_ok; subst. rewrite H in H7; inversion H7; subst. clear m4 m5 H3 H4 H7 H6.
simpl in subexpr_ok; rewrite H in subexpr_ok.
case_eq (Gamma e1); intros; rewrite H0 in subexpr_ok; [ | inversion subexpr_ok ].
case_eq (Gamma e2); intros; rewrite H1 in subexpr_ok; [ | inversion subexpr_ok ].
andb_to_prop subexpr_ok.
apply EquivEqBoolEq in L0; subst.
pose proof (typingSoundnessExp _ _ R0 e1_float).
pose proof (typingSoundnessExp _ _ R e2_float).
rewrite H0 in H2; rewrite H1 in H3; inversion H2; inversion H3; subst.
clear H2 H3 H0 H1.
andb_to_prop valid_error.
rename R0 into valid_error.
rename R2 into valid_error.
apply Qle_bool_iff in valid_error.
apply Qle_Rle in valid_error.
repeat rewrite Q2R_plus in valid_error.
......@@ -455,15 +475,17 @@ Qed.
Lemma validErrorboundCorrectMult E1 E2 absenv
(e1:exp Q) (e2:exp Q) (nR nR1 nR2 nF nF1 nF2 :R) (e err1 err2 :error)
(alo ahi e1lo e1hi e2lo e2hi:Q) dVars (m m1 m2:mType) Gamma:
(alo ahi e1lo e1hi e2lo e2hi:Q) dVars (m m1 m2:mType) Gamma defVars:
m = computeJoin m1 m2 ->
eval_exp E1 (toREval (toRExp e1)) nR1 M0 ->
eval_exp E1 (toREval (toRExp e2)) nR2 M0 ->
eval_exp E1 (toREval (toRExp (Binop Mult e1 e2))) nR M0 ->
eval_exp E2 (toRExp e1) nF1 m1 ->
eval_exp E2 (toRExp e2) nF2 m2 ->
eval_exp (updEnv 2 m2 nF2 (updEnv 1 m1 nF1 emptyEnv)) (toRExp (Binop Mult (Var Q m1 1) (Var Q m2 2))) nF m ->
validType Gamma (Binop Mult e1 e2) m ->
eval_exp E1 (toREvalVars defVars) (toREval (toRExp e1)) nR1 M0 ->
eval_exp E1 (toREvalVars defVars) (toREval (toRExp e2)) nR2 M0 ->
eval_exp E1 (toREvalVars defVars) (toREval (toRExp (Binop Mult e1 e2))) nR M0 ->
eval_exp E2 defVars (toRExp e1) nF1 m1 ->
eval_exp E2 defVars (toRExp e2) nF2 m2 ->
eval_exp (updEnv 2 nF2 (updEnv 1 nF1 emptyEnv))
(fun n => if (n =? 2) then Some m2 else if (n =? 1) then Some m1 else defVars n)
(toRExp (Binop Mult (Var Q 1) (Var Q 2))) nF m ->
typeCheck (Binop Mult e1 e2) defVars Gamma = true ->
validErrorbound (Binop Mult e1 e2) Gamma absenv dVars = true ->
(Q2R e1lo <= nR1 <= Q2R e1hi)%R ->
(Q2R e2lo <= nR2 <= Q2R e2hi)%R ->
......@@ -482,9 +504,17 @@ Proof.
unfold validErrorbound in valid_error.
rewrite absenv_mult,absenv_e1,absenv_e2 in valid_error.
case_eq (Gamma (Binop Mult e1 e2)); intros; rewrite H in valid_error; [ | inversion valid_error ].
inversion subexpr_ok; subst. rewrite H in H7; inversion H7; subst. clear m4 m5 H3 H4 H7 H6.
simpl in subexpr_ok; rewrite H in subexpr_ok.
case_eq (Gamma e1); intros; rewrite H0 in subexpr_ok; [ | inversion subexpr_ok ].
case_eq (Gamma e2); intros; rewrite H1 in subexpr_ok; [ | inversion subexpr_ok ].
andb_to_prop subexpr_ok.
apply EquivEqBoolEq in L0; subst.
pose proof (typingSoundnessExp _ _ R0 e1_float).
pose proof (typingSoundnessExp _ _ R e2_float).
rewrite H0 in H2; rewrite H1 in H3; inversion H2; inversion H3; subst.
clear H2 H3 H0 H1.
andb_to_prop valid_error.
rename R0 into valid_error.
rename R2 into valid_error.
assert (0 <= Q2R err1)%R as err1_pos by (eapply (err_always_positive e1 Gamma absenv dVars); eauto).
assert (0 <= Q2R err2)%R as err2_pos by (eapply (err_always_positive e2 Gamma absenv dVars); eauto).
clear R L1.
......@@ -985,15 +1015,17 @@ Qed.
Lemma validErrorboundCorrectDiv E1 E2 absenv
(e1:exp Q) (e2:exp Q) (nR nR1 nR2 nF nF1 nF2 :R) (e err1 err2 :error)
(alo ahi e1lo e1hi e2lo e2hi:Q) dVars (m m1 m2:mType) Gamma:
(alo ahi e1lo e1hi e2lo e2hi:Q) dVars (m m1 m2:mType) Gamma defVars:
m = computeJoin m1 m2 ->
eval_exp E1 (toREval (toRExp e1)) nR1 M0 ->
eval_exp E1 (toREval (toRExp e2)) nR2 M0 ->
eval_exp E1 (toREval (toRExp (Binop Div e1 e2))) nR M0 ->
eval_exp E2 (toRExp e1) nF1 m1 ->
eval_exp E2 (toRExp e2) nF2 m2 ->
eval_exp (updEnv 2 m2 nF2 (updEnv 1 m1 nF1 emptyEnv)) (toRExp (Binop Div (Var Q m1 1) (Var Q m2 2))) nF m ->
validType Gamma (Binop Div e1 e2) m ->
eval_exp E1 (toREvalVars defVars) (toREval (toRExp e1)) nR1 M0 ->
eval_exp E1 (toREvalVars defVars) (toREval (toRExp e2)) nR2 M0 ->
eval_exp E1 (toREvalVars defVars) (toREval (toRExp (Binop Div e1 e2))) nR M0 ->
eval_exp E2 defVars (toRExp e1) nF1 m1 ->
eval_exp E2 defVars (toRExp e2) nF2 m2 ->
eval_exp (updEnv 2 nF2 (updEnv 1 nF1 emptyEnv))
(fun n => if (n =? 2) then Some m2 else if (n =? 1) then Some m1 else defVars n)
(toRExp (Binop Div (Var Q 1) (Var Q 2))) nF m ->
typeCheck (Binop Div e1 e2) defVars Gamma = true ->
validErrorbound (Binop Div e1 e2) Gamma absenv dVars = true ->
(Q2R e1lo <= nR1 <= Q2R e1hi)%R ->
(Q2R e2lo <= nR2 <= Q2R e2hi)%R ->
......@@ -1013,13 +1045,17 @@ Proof.
unfold validErrorbound in valid_error.
rewrite absenv_div,absenv_e1,absenv_e2 in valid_error.
case_eq (Gamma (Binop Div e1 e2)); intros; rewrite H in valid_error; [ | inversion valid_error ].
inversion subexpr_ok; subst. rewrite H in H7; inversion H7; subst. clear m4 m5 H3 H4 H7 H6.
rename H into type_binop.
simpl in subexpr_ok; rewrite H in subexpr_ok.
case_eq (Gamma e1); intros; rewrite H0 in subexpr_ok; [ | inversion subexpr_ok ].
case_eq (Gamma e2); intros; rewrite H1 in subexpr_ok; [ | inversion subexpr_ok ].
andb_to_prop subexpr_ok.
apply EquivEqBoolEq in L0; subst.
pose proof (typingSoundnessExp _ _ R0 e1_float).
pose proof (typingSoundnessExp _ _ R e2_float).
rewrite H0 in H2; rewrite H1 in H3; inversion H2; inversion H3; subst.
clear H2 H3 H0 H1.
andb_to_prop valid_error.
assert (validErrorbound e1 Gamma absenv dVars = true) as valid_err_e1 by auto;
assert (validErrorbound e2 Gamma absenv dVars = true) as valid_err_e2 by auto.
clear L1 R.
rename R1 into valid_error.
rename R3 into valid_error.
rename L0 into no_div_zero_float.
assert (contained nR1 (Q2R e1lo, Q2R e1hi)) as contained_intv1 by auto.
pose proof (distance_gives_iv (a:=nR1) _ contained_intv1 err1_bounded).
......@@ -1050,7 +1086,7 @@ Proof.
(* Error Propagation proof *)
+ clear absenv_e1 absenv_e2 valid_error eval_float eval_real e1_float
e1_real e2_float e2_real absenv_div
valid_err_e1 valid_err_e2 E1 E2 absenv alo ahi nR nF e1 e2 e L subexpr_ok type_binop.
E1 E2 alo ahi nR nF e L.
unfold IntervalArith.contained, widenInterval in *.
simpl in *.
rewrite Q2R_plus, Q2R_minus in no_div_zero_float.
......@@ -1087,7 +1123,7 @@ Proof.
rewrite <- Q2R_plus in float_iv_neg.
rewrite <- Q2R0_is_0 in float_iv_neg.
rewrite <- Q2R0_is_0 in real_iv_neg.
pose proof (err_prop_inversion_neg float_iv_neg real_iv_neg err2_bounded valid_bounds_e2 H0 err2_pos) as err_prop_inv.
pose proof (err_prop_inversion_neg float_iv_neg real_iv_neg err2_bounded valid_bounds_e2 H1 err2_pos) as err_prop_inv.
rewrite Q2R_plus in float_iv_neg.
rewrite Q2R0_is_0 in float_iv_neg.
rewrite Q2R0_is_0 in real_iv_neg.
......@@ -1526,7 +1562,7 @@ Proof.
rewrite <- Q2R_minus in float_iv_pos.
rewrite <- Q2R0_is_0 in float_iv_pos.
rewrite <- Q2R0_is_0 in real_iv_pos.
pose proof (err_prop_inversion_pos float_iv_pos real_iv_pos err2_bounded valid_bounds_e2 H0 err2_pos) as err_prop_inv.
pose proof (err_prop_inversion_pos float_iv_pos real_iv_pos err2_bounded valid_bounds_e2 H1 err2_pos) as err_prop_inv.
rewrite Q2R_minus in float_iv_pos.
rewrite Q2R0_is_0 in float_iv_pos.
rewrite Q2R0_is_0 in real_iv_pos.
......@@ -1848,20 +1884,20 @@ Proof.
assert (IVhi (widenInterval (Q2R e2lo, Q2R e2hi) (Q2R err2)) < 0 \/ 0 < IVlo (widenInterval (Q2R e2lo, Q2R e2hi) (Q2R err2)))%R
as no_div_zero_widen
by (unfold widenInterval in *; simpl in *; rewrite Q2R_plus, Q2R_minus in no_div_zero_float; auto).
pose proof (IntervalArith.interval_division_valid no_div_zero_widen H H0) as valid_div_float.
pose proof (IntervalArith.interval_division_valid no_div_zero_widen H0 H1) as valid_div_float.
unfold IntervalArith.contained, widenInterval in *; simpl in *.
assert (e2lo - err2 == 0 -> False).
* hnf; intros.
destruct no_div_zero_float as [float_iv | float_iv]; rewrite <- Q2R0_is_0 in float_iv; apply Rlt_Qlt in float_iv; try lra.
assert (Q2R e2lo - Q2R err2 <= Q2R e2hi + Q2R err2)%R by lra.
rewrite<- Q2R_minus, <- Q2R_plus in H4.
apply Rle_Qle in H4. lra.
rewrite<- Q2R_minus, <- Q2R_plus in H5.
apply Rle_Qle in H5. lra.
* assert (e2hi + err2 == 0 -> False).
{ hnf; intros.
destruct no_div_zero_float as [float_iv | float_iv]; rewrite <- Q2R0_is_0 in float_iv; apply Rlt_Qlt in float_iv; try lra.
assert (Q2R e2lo - Q2R err2 <= Q2R e2hi + Q2R err2)%R by lra.
rewrite<- Q2R_minus, <- Q2R_plus in H5.