Commit 5607882d authored by ='s avatar =

Certificate checking Coq development is now finished?

parent e8c5b014
...@@ -12,9 +12,11 @@ Require Export Coq.QArith.QArith. ...@@ -12,9 +12,11 @@ Require Export Coq.QArith.QArith.
Require Export Daisy.Infra.ExpressionAbbrevs Daisy.Commands. Require Export Daisy.Infra.ExpressionAbbrevs Daisy.Commands.
(** Certificate checking function **) (** 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 (validIntervalbounds e absenv P NatSet.empty) if (typeCheck e defVars (typeMap defVars e)) then
then (validErrorbound e (fun (e:exp Q) => typeExpression e) absenv NatSet.empty) if (validIntervalbounds e absenv P NatSet.empty)
then (validErrorbound e (typeMap defVars e) absenv NatSet.empty)
else false
else false. else false.
(** (**
...@@ -22,16 +24,16 @@ Definition CertificateChecker (e:exp Q) (absenv:analysisResult) (P:precond) := ...@@ -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 Apart from assuming two executions, one in R and one on floats, we assume that
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: 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) (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 -> (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) -> (Q2R (fst (P v)) <= vR <= Q2R (snd (P v)))%R) ->
NatSet.Subset (Expressions.usedVars e) fVars -> NatSet.Subset (Expressions.usedVars e) fVars ->
eval_exp E1 (toREval (toRExp e)) vR M0 -> eval_exp E1 (toREvalVars defVars) (toREval (toRExp e)) vR M0 ->
eval_exp E2 (toRExp e) vF m -> eval_exp E2 defVars (toRExp e) vF m ->
CertificateChecker e absenv P = true -> CertificateChecker e absenv P defVars = true ->
(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
...@@ -47,33 +49,33 @@ Proof. ...@@ -47,33 +49,33 @@ Proof.
destruct iv as [ivlo ivhi]. destruct iv as [ivlo ivhi].
rewrite absenv_eq; simpl. rewrite absenv_eq; simpl.
eapply validErrorbound_sound; eauto. eapply validErrorbound_sound; eauto.
- admit. (*eapply validTypeMap; eauto. *)
- hnf. intros a in_diff. - hnf. intros a in_diff.
rewrite NatSet.diff_spec in in_diff. rewrite NatSet.diff_spec in in_diff.
apply fVars_subset. apply fVars_subset.
destruct in_diff; auto. destruct in_diff; auto.
- intros v m0 v_in_empty. - 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.
Admitted. Qed.
(* Qed. *)
Definition CertificateCheckerCmd (f:cmd Q) (absenv:analysisResult) (P:precond) := Definition CertificateCheckerCmd (f:cmd Q) (absenv:analysisResult) (P:precond) defVars:=
if (validIntervalboundsCmd f absenv P NatSet.empty) if (typeCheckCmd f defVars (typeMapCmd defVars f))
then (validErrorboundCmd f (fun e => typeExpression e) absenv NatSet.empty) then if (validIntervalboundsCmd f absenv P NatSet.empty)
then (validErrorboundCmd f (typeMapCmd defVars f) absenv NatSet.empty)
else false
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, 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 -> (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) -> (Q2R (fst (P v)) <= vR <= Q2R (snd (P v)))%R) ->
NatSet.Subset (Commands.freeVars f) fVars -> NatSet.Subset (Commands.freeVars f) fVars ->
ssa f fVars outVars -> ssa f fVars outVars ->
bstep (toREvalCmd (toRCmd f)) E1 vR M0 -> bstep (toREvalCmd (toRCmd f)) E1 (toREvalVars defVars) vR M0 ->
bstep (toRCmd f) E2 vF m -> bstep (toRCmd f) E2 defVars vF m ->
CertificateCheckerCmd f absenv P = true -> CertificateCheckerCmd f absenv P defVars = true ->
(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
...@@ -90,7 +92,6 @@ Proof. ...@@ -90,7 +92,6 @@ Proof.
destruct iv as [ivlo ivhi]. destruct iv as [ivlo ivhi].
rewrite absenv_eq; simpl. rewrite absenv_eq; simpl.
eapply (validErrorboundCmd_sound); eauto. eapply (validErrorboundCmd_sound); eauto.
- admit. (* eapply typeMapCmdValid; eauto.*)
- instantiate (1 := outVars). - instantiate (1 := outVars).
eapply ssa_equal_set; try eauto. eapply ssa_equal_set; try eauto.
hnf. hnf.
...@@ -103,7 +104,7 @@ Proof. ...@@ -103,7 +104,7 @@ Proof.
rewrite NatSet.diff_spec in in_diff. rewrite NatSet.diff_spec in in_diff.
destruct in_diff. destruct in_diff.
apply fVars_subset; auto. apply fVars_subset; auto.
- intros v m1 v_in_empty. - 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.
Admitted. Qed.
\ No newline at end of file \ No newline at end of file
...@@ -52,7 +52,8 @@ Inductive sstep : cmd R -> env -> R -> cmd R -> env -> Prop := ...@@ -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 := 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 ->
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' 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 ->
......
...@@ -12,24 +12,25 @@ It is necessary to have this relation, since two evaluations of the very same ...@@ -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 expression may yield different values for different machine epsilons
(or environments that already only approximate each other) (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: |approxRefl A:
approxEnv emptyEnv A NatSet.empty NatSet.empty emptyEnv approxEnv emptyEnv (fun n => None) A NatSet.empty NatSet.empty emptyEnv
|approxUpdFree E1 E2 A v1 v2 x fVars dVars m: |approxUpdFree E1 E2 defVars A v1 v2 x fVars dVars m:
approxEnv E1 A fVars dVars E2 -> approxEnv E1 defVars A fVars dVars E2 ->
defVars x = Some m ->
(Rabs (v1 - v2) <= (Rabs v1) * Q2R (meps 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 M0 v1 E1) A (NatSet.add x fVars) dVars (updEnv x m v2 E2) approxEnv (updEnv x v1 E1) defVars A (NatSet.add x fVars) dVars (updEnv x v2 E2)
|approxUpdBound E1 E2 A v1 v2 x fVars dVars m: |approxUpdBound E1 E2 defVars A v1 v2 x fVars dVars:
approxEnv E1 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 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 := (* Inductive approxParams :env -> env -> Prop := *)
|approxParamRefl: (* |approxParamRefl: *)
approxParams emptyEnv emptyEnv (* approxParams emptyEnv emptyEnv *)
|approxParamUpd E1 E2 m x v1 v2 : (* |approxParamUpd E1 E2 m x v1 v2 : *)
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). *)
...@@ -8,7 +8,7 @@ Require Import Daisy.Infra.Abbrevs Daisy.Infra.RationalSimps Daisy.Infra.RealSim ...@@ -8,7 +8,7 @@ Require Import Daisy.Infra.Abbrevs Daisy.Infra.RationalSimps Daisy.Infra.RealSim
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) defVars: 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 -> 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.
...@@ -45,12 +45,12 @@ Qed. ...@@ -45,12 +45,12 @@ 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 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 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 E2 defVars (toRExp e2) e2F m2 ->
eval_exp E1 defVars (toREval (Binop Plus (toRExp e1) (toRExp e2))) vR M0 -> eval_exp E1 (toREvalVars 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 (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 (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.
...@@ -110,12 +110,12 @@ Qed. ...@@ -110,12 +110,12 @@ 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 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 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 E2 defVars (toRExp e2) e2F m2 ->
eval_exp E1 defVars (toREval (Binop Sub (toRExp e1) (toRExp e2))) vR M0 -> eval_exp E1 (toREvalVars 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 (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 (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.
...@@ -169,12 +169,12 @@ Qed. ...@@ -169,12 +169,12 @@ 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 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 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 E2 defVars (toRExp e2) e2F m2 ->
eval_exp E1 defVars (toREval (Binop Mult (toRExp e1) (toRExp e2))) vR M0 -> eval_exp E1 (toREvalVars 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 (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. (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.
...@@ -218,12 +218,12 @@ Qed. ...@@ -218,12 +218,12 @@ 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 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 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 E2 defVars (toRExp e2) e2F m2 ->
eval_exp E1 defVars (toREval (Binop Div (toRExp e1) (toRExp e2))) vR M0 -> eval_exp E1 (toREvalVars 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 (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. (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.
...@@ -443,9 +443,9 @@ Proof. ...@@ -443,9 +443,9 @@ 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 defVars (toREval e) nR M0 -> eval_exp E1 (toREvalVars defVars) (toREval e) nR M0 ->
eval_exp E2 defVars e nF1 m -> 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 - 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.
......
...@@ -109,28 +109,28 @@ Qed. ...@@ -109,28 +109,28 @@ Qed.
Lemma validErrorboundCorrectVariable: Lemma validErrorboundCorrectVariable:
forall E1 E2 absenv (v:nat) nR nF e nlo nhi P fVars dVars m Gamma defVars, forall E1 E2 absenv (v:nat) nR nF e nlo nhi P fVars dVars m Gamma defVars,
typeCheck (Var Q v) defVars Gamma = true -> typeCheck (Var Q v) defVars Gamma = true ->
approxEnv E1 absenv fVars dVars E2 -> approxEnv E1 defVars absenv fVars dVars E2 ->
eval_exp E1 defVars (toREval (toRExp (Var Q v))) nR M0 -> eval_exp E1 (toREvalVars defVars) (toREval (toRExp (Var Q v))) nR M0 ->
eval_exp E2 defVars (toRExp (Var Q v)) nF m -> eval_exp E2 defVars (toRExp (Var Q v)) nF m ->
validIntervalbounds (Var Q v) absenv P dVars = true -> validIntervalbounds (Var Q v) absenv P dVars = true ->
validErrorbound (Var Q v) Gamma absenv dVars = true -> validErrorbound (Var Q v) Gamma absenv dVars = true ->
(forall v1, (forall v1,
NatSet.mem v1 dVars = true -> 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) -> (Q2R (fst (fst (absenv (Var Q v1)))) <= r <= Q2R (snd (fst (absenv (Var Q v1)))))%R) ->
(forall v1, NatSet.mem v1 fVars= true -> (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) -> (Q2R (fst (P v1)) <= r <= Q2R (snd (P v1)))%R) ->
absenv (Var Q v) = ((nlo, nhi), e) -> absenv (Var Q v) = ((nlo, nhi), e) ->
(Rabs (nR - nF) <= (Q2R e))%R. (Rabs (nR - nF) <= (Q2R e))%R.
Proof. Proof.
intros * typing_ok approxCEnv eval_real eval_float bounds_valid error_valid dVars_sound P_valid absenv_var. 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. simpl in eval_real; inversion eval_real; inversion eval_float; subst.
rename H2 into E1_v; rename H1 into E1_v;
rename H7 into E2_v. rename H6 into E2_v.
simpl in error_valid. simpl in error_valid.
rewrite absenv_var in error_valid; simpl in error_valid; subst. 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. rewrite <- andb_lazy_alt in error_valid.
andb_to_prop error_valid. andb_to_prop error_valid.
rename L into error_pos. rename L into error_pos.
...@@ -159,17 +159,17 @@ Proof. ...@@ -159,17 +159,17 @@ Proof.
apply Qle_Rle in error_valid. apply Qle_Rle in error_valid.
eapply Rle_trans; eauto. eapply Rle_trans; eauto.
rewrite Q2R_mult. rewrite Q2R_mult.
inversion typing_ok; subst. rewrite H5 in H1; inversion H1; subst.
rewrite H in H5; inversion H5; subst. rewrite H,H5 in typing_ok; apply EquivEqBoolEq in typing_ok; subst.
clear H5 H3. clear H5 H3.
apply Rmult_le_compat_r. apply Rmult_le_compat_r.
{ apply inj_eps_posR. } { apply inj_eps_posR. }
{ rewrite <- maxAbs_impl_RmaxAbs. { rewrite <- maxAbs_impl_RmaxAbs.
apply contained_leq_maxAbs. apply contained_leq_maxAbs.
unfold contained; simpl. unfold contained; simpl.
assert ((toRExp (Var Q m x)) = Var R m x) by (simpl; auto). assert ((toRExp (Var Q x)) = Var R x) by (simpl; auto).
rewrite <- H2 in eval_float. rewrite <- H3 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. 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. rewrite absenv_var in valid_bounds_prf; simpl in valid_bounds_prf.
apply valid_bounds_prf; try auto. apply valid_bounds_prf; try auto.
- intros v v_mem_diff. - intros v v_mem_diff.
...@@ -180,9 +180,9 @@ Proof. ...@@ -180,9 +180,9 @@ Proof.
+ apply IHapproxCEnv; try auto. + apply IHapproxCEnv; try auto.
* constructor; auto. * constructor; auto.
* constructor; auto. * constructor; auto.
* intros v0 m2 mem_dVars. * intros v0 mem_dVars.
specialize (dVars_sound v0 m2 mem_dVars). specialize (dVars_sound v0 mem_dVars).
destruct dVars_sound as [vR0 [mR0 iv_sound_val]]. destruct dVars_sound as [vR0 iv_sound_val].
case_eq (v0 =? x); intros case_mem; case_eq (v0 =? x); intros case_mem;
rewrite case_mem in iv_sound_val; simpl in iv_sound_val. rewrite case_mem in iv_sound_val; simpl in iv_sound_val.
{ rewrite Nat.eqb_eq in case_mem; subst. { rewrite Nat.eqb_eq in case_mem; subst.
...@@ -191,7 +191,7 @@ Proof. ...@@ -191,7 +191,7 @@ Proof.
as x_in_union by (rewrite NatSet.union_spec; auto). as x_in_union by (rewrite NatSet.union_spec; auto).
rewrite <- NatSet.mem_spec in x_in_union; rewrite <- NatSet.mem_spec in x_in_union;
rewrite x_in_union in *; congruence. } 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. * intros v0 v0_fVar.
assert (NatSet.mem v0 (NatSet.add x fVars) = true) 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). 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. ...@@ -237,16 +237,16 @@ Proof.
+ rewrite <- NatSet.mem_spec in v_dVar. rewrite v_dVar in case_dVars. + rewrite <- NatSet.mem_spec in v_dVar. rewrite v_dVar in case_dVars.
inversion case_dVars. } inversion case_dVars. }
{ rewrite not_in_add in error_valid; auto. } { rewrite not_in_add in error_valid; auto. }
* intros v0 m2 mem_dVars. * intros v0 mem_dVars.
specialize (dVars_sound v0 m2). specialize (dVars_sound v0).
rewrite absenv_var in *; simpl in *. rewrite absenv_var in *; simpl in *.
rewrite NatSet.mem_spec in mem_dVars. rewrite NatSet.mem_spec in mem_dVars.
assert (NatSet.In v0 (NatSet.add x dVars)) as v0_in_add. assert (NatSet.In v0 (NatSet.add x dVars)) as v0_in_add.
{ rewrite NatSet.add_spec. right; auto. } { rewrite NatSet.add_spec. right; auto. }
{ rewrite <- NatSet.mem_spec in v0_in_add. { rewrite <- NatSet.mem_spec in v0_in_add.
specialize (dVars_sound v0_in_add). specialize (dVars_sound v0_in_add).
destruct dVars_sound as [vR0 [mR0 [val_def iv_sound_val]]]. destruct dVars_sound as [vR0 [val_def iv_sound_val]].
exists vR0, mR0; split; auto. exists vR0; split; auto.
unfold updEnv in val_def; simpl in val_def. unfold updEnv in val_def; simpl in val_def.
case_eq (v0 =? x); intros case_mem; case_eq (v0 =? x); intros case_mem;
rewrite case_mem in val_def; simpl in val_def. rewrite case_mem in val_def; simpl in val_def.
...@@ -268,10 +268,10 @@ Proof. ...@@ -268,10 +268,10 @@ Proof.
Qed. Qed.
Lemma validErrorboundCorrectConstant: Lemma validErrorboundCorrectConstant:
forall E1 E2 absenv (n:Q) nR nF e nlo nhi dVars m Gamma, forall E1 E2 absenv (n:Q) nR nF e nlo nhi dVars m Gamma defVars,
eval_exp E1 (toREval (toRExp (Const m n))) nR M0 -> eval_exp E1 (toREvalVars defVars) (toREval (toRExp (Const m n))) nR M0 ->
eval_exp E2 (toRExp (Const m n)) nF m -> eval_exp E2 defVars (toRExp (Const m n)) nF m ->
validType Gamma (Const m n) m -> typeCheck (Const m n) defVars Gamma = true ->
validErrorbound (Const m n) Gamma absenv dVars = true -> validErrorbound (Const m n) Gamma absenv dVars = true ->
(Q2R nlo <= nR <= Q2R nhi)%R -> (Q2R nlo <= nR <= Q2R nhi)%R ->
absenv (Const m n) = ((nlo,nhi),e) -> absenv (Const m n) = ((nlo,nhi),e) ->
...@@ -299,20 +299,22 @@ Proof. ...@@ -299,20 +299,22 @@ Proof.
- rewrite Q2R_mult in error_valid. - rewrite Q2R_mult in error_valid.
rewrite <- maxAbs_impl_RmaxAbs in error_valid; auto. rewrite <- maxAbs_impl_RmaxAbs in error_valid; auto.
inversion subexpr_ok; subst. inversion subexpr_ok; subst.
rewrite H in H6; inversion H6; subst; auto. rewrite H in H4. apply EquivEqBoolEq in H4; subst; auto.
Qed. Qed.
Lemma validErrorboundCorrectAddition E1 E2 absenv Lemma validErrorboundCorrectAddition E1 E2 absenv
(e1:exp Q) (e2:exp Q) (nR nR1 nR2 nF nF1 nF2 :R) (e err1 err2 :error) (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 -> m = computeJoin m1 m2 ->
eval_exp E1 (toREval (toRExp e1)) nR1 M0 -> eval_exp E1 (toREvalVars defVars) (toREval (toRExp e1)) nR1 M0 ->
eval_exp E1 (toREval (toRExp e2)) nR2 M0 -> eval_exp E1 (toREvalVars defVars) (toREval (toRExp e2)) nR2 M0 ->
eval_exp E1 (toREval (toRExp (Binop Plus e1 e2))) nR M0 -> eval_exp E1 (toREvalVars defVars) (toREval (toRExp (Binop Plus e1 e2))) nR M0 ->
eval_exp E2 (toRExp e1) nF1 m1 -> eval_exp E2 defVars (toRExp e1) nF1 m1 ->
eval_exp E2 (toRExp e2) nF2 m2 -> eval_exp E2 defVars (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 -> eval_exp (updEnv 2 nF2 (updEnv 1 nF1 emptyEnv))
validType Gamma (Binop Plus e1 e2) m -> (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 -> validErrorbound (Binop Plus e1 e2) Gamma absenv dVars = true ->
(Q2R e1lo <= nR1 <= Q2R e1hi)%R -> (Q2R e1lo <= nR1 <= Q2R e1hi)%R ->
(Q2R e2lo <= nR2 <= Q2R e2hi)%R -> (Q2R e2lo <= nR2 <= Q2R e2hi)%R ->
...@@ -333,9 +335,17 @@ Proof. ...@@ -333,9 +335,17 @@ Proof.
unfold validErrorbound in valid_error. unfold validErrorbound in valid_error.
rewrite absenv_add,absenv_e1,absenv_e2 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 ]. 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. andb_to_prop valid_error.
rename R0 into valid_error. rename R2 into valid_error.
eapply Rle_trans. eapply Rle_trans.
apply Rplus_le_compat_l. apply Rplus_le_compat_l.
eapply Rmult_le_compat_r. eapply Rmult_le_compat_r.
...@@ -378,15 +388,17 @@ Qed. ...@@ -378,15 +388,17 @@ Qed.
Lemma validErrorboundCorrectSubtraction E1 E2 absenv