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.
......
This diff is collapsed.
...@@ -205,13 +205,6 @@ Fixpoint toREval (e:exp R) := ...@@ -205,13 +205,6 @@ Fixpoint toREval (e:exp R) :=
| Downcast _ e1 => (toREval e1) | Downcast _ e1 => (toREval e1)
end. end.
Definition toREvalEnv (E:env) : env :=
fun (n:nat) =>
let s := (E n) in
match s with
| None => None
| Some (r, _) => Some (r, M0)
end.
(** (**
...@@ -229,7 +222,7 @@ using a perturbation of the real valued computation by (1 + delta), where ...@@ -229,7 +222,7 @@ using a perturbation of the real valued computation by (1 + delta), where
Inductive eval_exp (E:env) (defVars: nat -> option mType) :(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 -> defVars x = Some m ->
E x = Some (v, m) -> E x = Some v ->
eval_exp E defVars (Var R 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)) ->
...@@ -340,19 +333,27 @@ Proof. ...@@ -340,19 +333,27 @@ Proof.
Qed. Qed.
Fixpoint toREvalVars (d:nat -> option mType) (n:nat) :=
match d n with
| Some m => Some M0
| None => None
end.
(** (**
Helping lemma. Needed in soundness proof. Helping lemma. Needed in soundness proof.
For each evaluation of using an arbitrary epsilon, we can replace it by 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 defVars: Lemma binary_unfolding b f1 f2 m E vF defVars:
eval_exp E defVars (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 defVars f1 vF1 m1 /\ eval_exp E defVars f1 vF1 m1 /\
eval_exp E defVars 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 vF2 (updEnv 1 vF1 emptyEnv))
(fun n => if (n =? 2) then Some m2 else if (n =? 1) then Some m1 else defVars n) (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. (Binop b (Var R 1) (Var R 2)) vF m.
Proof. Proof.
...@@ -366,28 +367,28 @@ Proof. ...@@ -366,28 +367,28 @@ Proof.
eapply Var_load; eauto. eapply Var_load; eauto.
Qed. Qed.
(* Analogous lemma for unary expressions. *) (* (* Analogous lemma for unary expressions. *) *)
Lemma unary_unfolding (e:exp R) (m:mType) (E:env) (v:R) defVars: (* Lemma unary_unfolding (e:exp R) (m:mType) (E:env) (v:R) defVars: *)
(eval_exp E defVars (Unop Inv e) v m -> (* (eval_exp E defVars (Unop Inv e) v m -> *)
exists v1 m1, (* exists v1 m1, *)
eval_exp E defVars e v1 m1 /\ (* eval_exp E defVars e v1 m1 /\ *)
eval_exp (updEnv 1 m1 v1 E) (fun n => if (n =? 1) then Some m1 else defVars n) (Unop Inv (Var R 1)) v m). (* eval_exp (updEnv 1 v1 E) (fun n => if (n =? 1) then Some m1 else defVars n) (Unop Inv (Var R 1)) v m). *)
Proof. (* Proof. *)
intros eval_un. (* intros eval_un. *)
inversion eval_un; subst. (* inversion eval_un; subst. *)
exists v1; exists m. (* exists v1; exists m. *)
repeat split; try auto. (* repeat split; try auto. *)
econstructor; try auto. (* econstructor; try auto. *)
pose proof (isMorePrecise_refl m). (* pose proof (isMorePrecise_refl m). *)
econstructor; eauto. (* econstructor; eauto. *)
Qed. (* Qed. *)
(** (* (** *)
Using the parametric expressions, define boolean expressions for conditionals (* Using the parametric expressions, define boolean expressions for conditionals *)
**) (* **) *)
Inductive bexp (V:Type) : Type := (* Inductive bexp (V:Type) : Type := *)
leq: exp V -> exp V -> bexp V (* leq: exp V -> exp V -> bexp V *)
| less: exp V -> exp V -> bexp V. (* | less: exp V -> exp V -> bexp V. *)
(** (**
Define evaluation of boolean expressions Define evaluation of boolean expressions
......
...@@ -45,7 +45,7 @@ Definition precond :Type := nat -> intv. ...@@ -45,7 +45,7 @@ Definition precond :Type := nat -> intv.
(** (**
Abbreviation for the type of a variable environment, which should be a partial function Abbreviation for the type of a variable environment, which should be a partial function
**) **)
Definition env := nat -> option (R * mType). Definition env := nat -> option R.
(** (**
The empty environment must return NONE for every variable The empty environment must return NONE for every variable
...@@ -55,7 +55,7 @@ Definition emptyEnv:env := fun _ => None. ...@@ -55,7 +55,7 @@ Definition emptyEnv:env := fun _ => None.
(** (**
Define environment update function as abbreviation, for variable environments Define environment update function as abbreviation, for variable environments
**) **)
Definition updEnv (x:nat) (mx:mType) (v: R) (E:env) (y:nat) := Definition updEnv (x:nat) (v: R) (E:env) (y:nat) :=
if (y =? x) if (y =? x)
then Some (v, mx) then Some v
else E y. else E y.
\ No newline at end of file
...@@ -170,19 +170,20 @@ Proof. ...@@ -170,19 +170,20 @@ Proof.
unfold isSupersetIntv in *; simpl in *. unfold isSupersetIntv in *; simpl in *.
apply le_neq_bool_to_lt_prop; auto. apply le_neq_bool_to_lt_prop; auto.
Qed. Qed.
Theorem validIntervalbounds_sound (f:exp Q) (absenv:analysisResult) (P:precond) fVars dVars (E:env) defVars: Theorem validIntervalbounds_sound (f:exp Q) (absenv:analysisResult) (P:precond) fVars dVars (E:env) defVars:
forall vR, forall vR,
(* validType Gamma f m -> *) (* validType Gamma f m -> *)
validIntervalbounds f absenv P dVars = true -> validIntervalbounds f absenv P dVars = true ->
(forall v, NatSet.mem v dVars = true -> (forall v, NatSet.mem v dVars = true ->
exists vR, E v = Some (vR, M0) /\ exists vR, E v = Some vR /\
(Q2R (fst (fst (absenv (Var Q v)))) <= vR <= Q2R (snd (fst (absenv (Var Q v)))))%R) -> (Q2R (fst (fst (absenv (Var Q v)))) <= vR <= Q2R (snd (fst (absenv (Var Q v)))))%R) ->
NatSet.Subset (NatSet.diff (Expressions.usedVars f) dVars) fVars -> NatSet.Subset (NatSet.diff (Expressions.usedVars f) dVars) fVars ->
(forall v, NatSet.mem v fVars = true -> (forall v, NatSet.mem v fVars = true ->
exists vR, E v = Some (vR, M0) /\ exists vR, E v = Some vR /\
(Q2R (fst (P v)) <= vR <= Q2R (snd (P v)))%R) -> (Q2R (fst (P v)) <= vR <= Q2R (snd (P v)))%R) ->
eval_exp E defVars (toREval (toRExp f)) vR M0 -> eval_exp E (toREvalVars defVars) (toREval (toRExp f)) vR M0 ->
(Q2R (fst (fst (absenv f))) <= vR <= Q2R (snd (fst (absenv f))))%R. (Q2R (fst (fst (absenv f))) <= vR <= Q2R (snd (fst (absenv f))))%R.
Proof. Proof.
induction f; intros vR valid_bounds valid_definedVars usedVars_subset valid_usedVars eval_f. induction f; intros vR valid_bounds valid_definedVars usedVars_subset valid_usedVars eval_f.
......
...@@ -29,9 +29,11 @@ Fixpoint typeMap (defVars:nat -> option mType) (e:exp Q) (e': exp Q) : option mT ...@@ -29,9 +29,11 @@ Fixpoint typeMap (defVars:nat -> option mType) (e:exp Q) (e': exp Q) : option mT
| Unop u e1 => if expEqBool e e' then typeExpression defVars e else typeMap defVars e1 e' | Unop u e1 => if expEqBool e e' then typeExpression defVars e else typeMap defVars e1 e'
| Binop b e1 e2 => if expEqBool e e' then typeExpression defVars e | Binop b e1 e2 => if expEqBool e e' then typeExpression defVars e
else else
match (typeMap defVars e1 e') with match (typeMap defVars e1 e'), (typeMap defVars e2 e') with
| None => typeMap defVars e2 e' | Some m1, Some m2 => if (mTypeEqBool m1 m2) then Some m1 else None
| x => x | Some m1, None => Some m1
| None, Some m2 => Some m2
| None, None => None
end end
| Downcast m e1 => if expEqBool e e' then typeExpression defVars (Downcast m e1) else typeMap defVars e1 e' | Downcast m e1 => if expEqBool e e' then typeExpression defVars (Downcast m e1) else typeMap defVars e1 e'
end. end.
...@@ -40,7 +42,7 @@ Fixpoint typeMap (defVars:nat -> option mType) (e:exp Q) (e': exp Q) : option mT ...@@ -40,7 +42,7 @@ Fixpoint typeMap (defVars:nat -> option mType) (e:exp Q) (e': exp Q) : option mT
Fixpoint typeCmd (defVars:nat -> option mType) (f:cmd Q): option mType := Fixpoint typeCmd (defVars:nat -> option mType) (f:cmd Q): option mType :=
match f with match f with
|Let m n e c => match typeExpression defVars e with |Let m n e c => match typeExpression defVars e with
|Some m' => if mTypeEqBool m m' then typeCmd (fun f => if (n =? f) then Some m else defVars f) c |Some m' => if mTypeEqBool m m' then typeCmd defVars (*(fun f => if (n =? f) then Some m else defVars f)*) c
else None else None
|None => None |None => None
end end
...@@ -50,10 +52,10 @@ Fixpoint typeCmd (defVars:nat -> option mType) (f:cmd Q): option mType := ...@@ -50,10 +52,10 @@ Fixpoint typeCmd (defVars:nat -> option mType) (f:cmd Q): option mType :=
Fixpoint typeMapCmd (defVars:nat -> option mType) (f:cmd Q) (f':exp Q) : option mType := Fixpoint typeMapCmd (defVars:nat -> option mType) (f:cmd Q) (f':exp Q) : option mType :=
match f with match f with
|Let m n e c => if expEqBool f' (Var Q n) then |Let m n e c => if expEqBool f' (Var Q n) then
match typeMap defVars e f' with match defVars n with
|None => None | Some m' => if mTypeEqBool m m' then Some m else None
|Some m1 => if