Commit 313ac660 authored by Heiko Becker's avatar Heiko Becker

Fix Fixed-Point implementation by properly implementing type join for fixed-points

parent c6efd235
...@@ -57,8 +57,8 @@ Proof. ...@@ -57,8 +57,8 @@ Proof.
destruct e5. destruct e5.
+ apply Ndec.Pcompare_Peqb in e8. + apply Ndec.Pcompare_Peqb in e8.
congruence. congruence.
+ apply Ndec.Pcompare_Peqb in Heq. + apply Nat.compare_eq in Heq; subst.
congruence. rewrite Nat.eqb_refl in H; congruence.
Qed. Qed.
Lemma usedVars_toREval_toRExp_compat e: Lemma usedVars_toREval_toRExp_compat e:
...@@ -69,10 +69,10 @@ Proof. ...@@ -69,10 +69,10 @@ Proof.
- now rewrite IHe1, IHe2, IHe3. - now rewrite IHe1, IHe2, IHe3.
Qed. Qed.
Lemma validRanges_eq_compat (e1: expr Q) e2 A E Gamma: Lemma validRanges_eq_compat (e1: expr Q) e2 A E Gamma fBits:
Q_orderedExps.eq e1 e2 -> Q_orderedExps.eq e1 e2 ->
validRanges e1 A E Gamma -> validRanges e1 A E Gamma fBits ->
validRanges e2 A E Gamma. validRanges e2 A E Gamma fBits.
Proof. Proof.
intros Heq. intros Heq.
unfold Q_orderedExps.eq in Heq. unfold Q_orderedExps.eq in Heq.
...@@ -104,8 +104,8 @@ Proof. ...@@ -104,8 +104,8 @@ Proof.
destruct e3. destruct e3.
+ apply Ndec.Pcompare_Peqb in e6. + apply Ndec.Pcompare_Peqb in e6.
congruence. congruence.
+ apply Ndec.Pcompare_Peqb in Heq. + apply Nat.compare_eq in Heq; subst.
congruence. rewrite Nat.eqb_refl in H; congruence.
- intros valid1; destruct valid1 as [validsub1 validr1]. - intros valid1; destruct valid1 as [validsub1 validr1].
specialize (IHc Heq validsub1). specialize (IHc Heq validsub1).
split; auto. split; auto.
...@@ -229,8 +229,8 @@ Proof. ...@@ -229,8 +229,8 @@ Proof.
destruct e5. destruct e5.
+ apply Ndec.Pcompare_Peqb in e8. + apply Ndec.Pcompare_Peqb in e8.
congruence. congruence.
+ apply Ndec.Pcompare_Peqb in Heq. + apply Nat.compare_eq in Heq; subst.
congruence. rewrite Nat.eqb_refl in *; congruence.
Qed. Qed.
Definition updateExpMapIncr e new_af noise (emap: expressionsAffine) intv incr := Definition updateExpMapIncr e new_af noise (emap: expressionsAffine) intv incr :=
...@@ -745,15 +745,15 @@ Proof. ...@@ -745,15 +745,15 @@ Proof.
congruence. congruence.
Qed. Qed.
Lemma validAffineBounds_validRanges e (A: analysisResult) E Gamma: Lemma validAffineBounds_validRanges e (A: analysisResult) E Gamma fBits:
(exists map af vR aiv aerr, (exists map af vR aiv aerr,
FloverMap.find e A = Some (aiv, aerr) /\ FloverMap.find e A = Some (aiv, aerr) /\
isSupersetIntv (toIntv af) aiv = true /\ isSupersetIntv (toIntv af) aiv = true /\
eval_expr E (toRMap Gamma) (toREval (toRExp e)) vR REAL /\ eval_expr E (toRMap Gamma) fBits (toREval (toRExp e)) vR REAL /\
af_evals (afQ2R af) vR map) -> af_evals (afQ2R af) vR map) ->
exists iv err vR, exists iv err vR,
FloverMap.find e A = Some (iv, err) /\ FloverMap.find e A = Some (iv, err) /\
eval_expr E (toRMap Gamma) (toREval (toRExp e)) vR REAL /\ eval_expr E (toRMap Gamma) fBits (toREval (toRExp e)) vR REAL /\
(Q2R (fst iv) <= vR <= Q2R (snd iv))%R. (Q2R (fst iv) <= vR <= Q2R (snd iv))%R.
Proof. Proof.
intros sound_affine. intros sound_affine.
...@@ -773,7 +773,7 @@ Proof. ...@@ -773,7 +773,7 @@ Proof.
split; eauto using Rle_trans. split; eauto using Rle_trans.
Qed. Qed.
Definition checked_expressions (A: analysisResult) E Gamma fVars dVars e iexpmap inoise map1 := Definition checked_expressions (A: analysisResult) E Gamma fBits fVars dVars e iexpmap inoise map1 :=
exists af vR aiv aerr, exists af vR aiv aerr,
NatSet.Subset (usedVars e) (NatSet.union fVars dVars) /\ NatSet.Subset (usedVars e) (NatSet.union fVars dVars) /\
FloverMap.find e A = Some (aiv, aerr) /\ FloverMap.find e A = Some (aiv, aerr) /\
...@@ -781,17 +781,17 @@ Definition checked_expressions (A: analysisResult) E Gamma fVars dVars e iexpmap ...@@ -781,17 +781,17 @@ Definition checked_expressions (A: analysisResult) E Gamma fVars dVars e iexpmap
FloverMap.find e iexpmap = Some af /\ FloverMap.find e iexpmap = Some af /\
fresh inoise af /\ fresh inoise af /\
(forall n, (n >= inoise)%nat -> map1 n = None) /\ (forall n, (n >= inoise)%nat -> map1 n = None) /\
eval_expr E (toRMap Gamma) (toREval (toRExp e)) vR REAL /\ eval_expr E (toRMap Gamma) fBits (toREval (toRExp e)) vR REAL /\
validRanges e A E Gamma /\ validRanges e A E Gamma fBits /\
af_evals (afQ2R af) vR map1. af_evals (afQ2R af) vR map1.
Lemma checked_expressions_contained A E Gamma fVars dVars e expmap1 expmap2 map1 map2 noise1 noise2: Lemma checked_expressions_contained A E Gamma fBits fVars dVars e expmap1 expmap2 map1 map2 noise1 noise2:
contained_map map1 map2 -> contained_map map1 map2 ->
contained_flover_map expmap1 expmap2 -> contained_flover_map expmap1 expmap2 ->
(noise2 >= noise1)%nat -> (noise2 >= noise1)%nat ->
(forall n : nat, (n >= noise2)%nat -> map2 n = None) -> (forall n : nat, (n >= noise2)%nat -> map2 n = None) ->
checked_expressions A E Gamma fVars dVars e expmap1 noise1 map1 -> checked_expressions A E Gamma fBits fVars dVars e expmap1 noise1 map1 ->
checked_expressions A E Gamma fVars dVars e expmap2 noise2 map2. checked_expressions A E Gamma fBits fVars dVars e expmap2 noise2 map2.
Proof. Proof.
intros cont contf Hnoise Hvalidmap checked1. intros cont contf Hnoise Hvalidmap checked1.
unfold checked_expressions in checked1 |-*. unfold checked_expressions in checked1 |-*.
...@@ -800,10 +800,10 @@ Proof. ...@@ -800,10 +800,10 @@ Proof.
intuition; eauto using fresh_monotonic, af_evals_map_extension. intuition; eauto using fresh_monotonic, af_evals_map_extension.
Qed. Qed.
Lemma checked_expressions_flover_map_add_compat A E Gamma fVars dVars e e' af expmap noise map: Lemma checked_expressions_flover_map_add_compat A E Gamma fBits fVars dVars e e' af expmap noise map:
Q_orderedExps.exprCompare e e' <> Eq -> Q_orderedExps.exprCompare e e' <> Eq ->
checked_expressions A E Gamma fVars dVars e' expmap noise map -> checked_expressions A E Gamma fBits fVars dVars e' expmap noise map ->
checked_expressions A E Gamma fVars dVars e' (FloverMap.add e af expmap) noise map. checked_expressions A E Gamma fBits fVars dVars e' (FloverMap.add e af expmap) noise map.
Proof. Proof.
intros Hneq checked1. intros Hneq checked1.
unfold checked_expressions in checked1 |-*. unfold checked_expressions in checked1 |-*.
...@@ -814,9 +814,9 @@ Proof. ...@@ -814,9 +814,9 @@ Proof.
Qed. Qed.
Lemma validAffineBounds_sound (e: expr Q) (A: analysisResult) (P: precond) Lemma validAffineBounds_sound (e: expr Q) (A: analysisResult) (P: precond)
fVars dVars (E: env) Gamma exprAfs noise iexpmap inoise map1: fVars dVars (E: env) Gamma fBits exprAfs noise iexpmap inoise map1:
(forall e, (exists af, FloverMap.find e iexpmap = Some af) -> (forall e, (exists af, FloverMap.find e iexpmap = Some af) ->
checked_expressions A E Gamma fVars dVars e iexpmap inoise map1) -> checked_expressions A E Gamma fBits fVars dVars e iexpmap inoise map1) ->
(inoise > 0)%nat -> (inoise > 0)%nat ->
(forall n, (n >= inoise)%nat -> map1 n = None) -> (forall n, (n >= inoise)%nat -> map1 n = None) ->
validAffineBounds e A P dVars iexpmap inoise = Some (exprAfs, noise) -> validAffineBounds e A P dVars iexpmap inoise = Some (exprAfs, noise) ->
...@@ -833,12 +833,12 @@ Lemma validAffineBounds_sound (e: expr Q) (A: analysisResult) (P: precond) ...@@ -833,12 +833,12 @@ Lemma validAffineBounds_sound (e: expr Q) (A: analysisResult) (P: precond)
fresh noise af /\ fresh noise af /\
(forall n, (n >= noise)%nat -> map2 n = None) /\ (forall n, (n >= noise)%nat -> map2 n = None) /\
(noise >= inoise)%nat /\ (noise >= inoise)%nat /\
eval_expr E (toRMap Gamma) (toREval (toRExp e)) vR REAL /\ eval_expr E (toRMap Gamma) fBits (toREval (toRExp e)) vR REAL /\
validRanges e A E Gamma /\ validRanges e A E Gamma fBits /\
af_evals (afQ2R af) vR map2 /\ af_evals (afQ2R af) vR map2 /\
(forall e, FloverMap.find e iexpmap = None -> (forall e, FloverMap.find e iexpmap = None ->
(exists af, FloverMap.find e exprAfs = Some af) -> (exists af, FloverMap.find e exprAfs = Some af) ->
checked_expressions A E Gamma fVars dVars e exprAfs noise map2). checked_expressions A E Gamma fBits fVars dVars e exprAfs noise map2).
Proof. Proof.
revert noise exprAfs inoise iexpmap map1. revert noise exprAfs inoise iexpmap map1.
induction e; induction e;
...@@ -885,7 +885,7 @@ Proof. ...@@ -885,7 +885,7 @@ Proof.
specialize (fVarsSound H') as [vR [eMap interval_containment]]. specialize (fVarsSound H') as [vR [eMap interval_containment]].
assert (FloverMap.find (Var Q n) (FloverMap.add (Var Q n) (fromIntv (P n) inoise) iexpmap) = Some (fromIntv (P n) inoise)) as Hfind assert (FloverMap.find (Var Q n) (FloverMap.add (Var Q n) (fromIntv (P n) inoise) iexpmap) = Some (fromIntv (P n) inoise)) as Hfind
by (rewrite FloverMapFacts.P.F.add_eq_o; try auto; apply Q_orderedExps.exprCompare_refl). by (rewrite FloverMapFacts.P.F.add_eq_o; try auto; apply Q_orderedExps.exprCompare_refl).
assert (eval_expr E (toRMap Gamma) (toREval (toRExp (Var Q n))) vR REAL) as Heeval assert (eval_expr E (toRMap Gamma) fBits (toREval (toRExp (Var Q n))) vR REAL) as Heeval
by (constructor; auto; simpl; rewrite varsTyped; reflexivity). by (constructor; auto; simpl; rewrite varsTyped; reflexivity).
destruct (Qeq_bool (ivlo (P n)) (ivhi (P n))) eqn: Heq. destruct (Qeq_bool (ivlo (P n)) (ivhi (P n))) eqn: Heq.
* assert (af_evals (afQ2R (fromIntv (P n) inoise)) vR map1) as Hevals. * assert (af_evals (afQ2R (fromIntv (P n) inoise)) vR map1) as Hevals.
...@@ -1137,7 +1137,7 @@ Proof. ...@@ -1137,7 +1137,7 @@ Proof.
assert (FloverMap.find (elt:=affine_form Q) (Const m v) (FloverMap.add (Const m v) (fromIntv (v, v) noise) iexpmap) = Some (fromIntv (v, v) noise)) assert (FloverMap.find (elt:=affine_form Q) (Const m v) (FloverMap.add (Const m v) (fromIntv (v, v) noise) iexpmap) = Some (fromIntv (v, v) noise))
by (rewrite FloverMapFacts.P.F.add_eq_o; try auto; by (rewrite FloverMapFacts.P.F.add_eq_o; try auto;
apply Q_orderedExps.exprCompare_refl). apply Q_orderedExps.exprCompare_refl).
assert (eval_expr E (toRMap Gamma) (toREval (toRExp (Const m v))) (perturb (Q2R v) REAL 0) REAL) assert (eval_expr E (toRMap Gamma) fBits (toREval (toRExp (Const m v))) (perturb (Q2R v) REAL 0) REAL)
by (constructor; simpl; rewrite Rabs_R0; lra). by (constructor; simpl; rewrite Rabs_R0; lra).
exists map1, (fromIntv (v, v) noise), (perturb (Q2R v) REAL 0), i, e. exists map1, (fromIntv (v, v) noise), (perturb (Q2R v) REAL 0), i, e.
repeat split; auto. repeat split; auto.
...@@ -1373,10 +1373,11 @@ Proof. ...@@ -1373,10 +1373,11 @@ Proof.
apply plus_aff_sound; auto. apply plus_aff_sound; auto.
eauto using af_evals_map_extension. eauto using af_evals_map_extension.
} }
assert (eval_expr E (toRMap Gamma) (toREval (toRExp (Binop Plus e1 e2))) assert (eval_expr E (toRMap Gamma) fBits (toREval (toRExp (Binop Plus e1 e2)))
(perturb (evalBinop Plus vR1 vR2) REAL 0) REAL) (perturb (evalBinop Plus vR1 vR2) REAL 0) REAL).
by (replace REAL with (join REAL REAL) by trivial; { eapply Binop_dist' with (delta := 0%R); eauto; try congruence.
apply Binop_dist; try rewrite Rabs_R0; simpl; auto; try lra; congruence). - rewrite Rabs_R0; cbn; lra.
- intros; cbn in *; contradiction. }
exists ihmap2, (AffineArithQ.plus_aff af1 af2), (perturb (evalBinop Plus vR1 vR2) REAL 0)%R, aiv, aerr. exists ihmap2, (AffineArithQ.plus_aff af1 af2), (perturb (evalBinop Plus vR1 vR2) REAL 0)%R, aiv, aerr.
rewrite plus_0_r. rewrite plus_0_r.
repeat split; eauto using AffineArithQ.plus_aff_preserves_fresh, fresh_monotonic. repeat split; eauto using AffineArithQ.plus_aff_preserves_fresh, fresh_monotonic.
...@@ -1461,9 +1462,10 @@ Proof. ...@@ -1461,9 +1462,10 @@ Proof.
unfold AffineArithQ.negate_aff. unfold AffineArithQ.negate_aff.
now apply AffineArithQ.fresh_mult_aff_const. now apply AffineArithQ.fresh_mult_aff_const.
} }
assert (eval_expr E (toRMap Gamma) (toREval (toRExp (Binop Sub e1 e2))) (perturb (evalBinop Sub vR1 vR2) REAL 0) REAL) assert (eval_expr E (toRMap Gamma) fBits (toREval (toRExp (Binop Sub e1 e2))) (perturb (evalBinop Sub vR1 vR2) REAL 0) REAL).
by (replace REAL with (join REAL REAL) by trivial; apply Binop_dist; { eapply Binop_dist' with (delta := 0%R); eauto; try congruence.
try rewrite Rabs_R0; simpl; auto; try lra; congruence). - rewrite Rabs_R0; cbn; lra.
- intros; cbn in *; contradiction. }
exists ihmap2, (AffineArithQ.subtract_aff af1 af2), (perturb (evalBinop Sub vR1 vR2) REAL 0)%R, aiv, aerr. exists ihmap2, (AffineArithQ.subtract_aff af1 af2), (perturb (evalBinop Sub vR1 vR2) REAL 0)%R, aiv, aerr.
repeat split; auto. repeat split; auto.
* etransitivity; try exact ihcont1. * etransitivity; try exact ihcont1.
...@@ -1556,9 +1558,10 @@ Proof. ...@@ -1556,9 +1558,10 @@ Proof.
apply AffineArithQ.mult_aff_aux_preserves_fresh; apply AffineArithQ.mult_aff_aux_preserves_fresh;
apply fresh_inc; now rewrite afQ2R_fresh. apply fresh_inc; now rewrite afQ2R_fresh.
} }
assert (eval_expr E (toRMap Gamma) (toREval (toRExp (Binop Mult e1 e2))) (perturb (evalBinop Mult vR1 vR2) REAL 0) REAL) assert (eval_expr E (toRMap Gamma) fBits (toREval (toRExp (Binop Mult e1 e2))) (perturb (evalBinop Mult vR1 vR2) REAL 0) REAL).
by (replace REAL with (join REAL REAL) by trivial; { eapply Binop_dist' with (delta := 0%R); eauto; try congruence.
apply Binop_dist; try rewrite Rabs_R0; simpl; auto; try lra; congruence). - rewrite Rabs_R0; cbn; lra.
- intros; cbn in *; contradiction. }
assert (af_evals (afQ2R (AffineArithQ.mult_aff af1 af2 subnoise2)) (perturb (evalBinop Mult vR1 vR2) REAL 0) (updMap ihmap2 subnoise2 qMult)) by assert (af_evals (afQ2R (AffineArithQ.mult_aff af1 af2 subnoise2)) (perturb (evalBinop Mult vR1 vR2) REAL 0) (updMap ihmap2 subnoise2 qMult)) by
(unfold perturb; simpl evalBinop; rewrite afQ2R_mult_aff; assumption). (unfold perturb; simpl evalBinop; rewrite afQ2R_mult_aff; assumption).
assert (forall n : nat, (n >= subnoise2 + 1)%nat -> updMap ihmap2 subnoise2 qMult n = None). assert (forall n : nat, (n >= subnoise2 + 1)%nat -> updMap ihmap2 subnoise2 qMult n = None).
...@@ -1712,11 +1715,11 @@ Proof. ...@@ -1712,11 +1715,11 @@ Proof.
apply Hsubvalidmap2. apply Hsubvalidmap2.
lia. lia.
} }
assert (eval_expr E (toRMap Gamma) (toREval (toRExp (Binop Div e1 e2))) (perturb (evalBinop Div vR1 vR2) REAL 0) REAL) assert (eval_expr E (toRMap Gamma) fBits (toREval (toRExp (Binop Div e1 e2))) (perturb (evalBinop Div vR1 vR2) REAL 0) REAL).
by (replace REAL with (join REAL REAL) by trivial; { eapply Binop_dist' with (delta := 0%R); eauto; try congruence.
apply Binop_dist; try rewrite Rabs_R0; simpl; auto; try lra; - rewrite Rabs_R0; cbn; lra.
intros _; - intros _; eauto using above_below_nonzero.
eauto using above_below_nonzero). - intros; cbn in *; contradiction. }
assert (af_evals (afQ2R (AffineArithQ.divide_aff af1 af2 subnoise2)) (perturb (evalBinop Div vR1 vR2) REAL 0) (updMap (updMap ihmap2 subnoise2 qInv) (subnoise2 + 1) qMult)) assert (af_evals (afQ2R (AffineArithQ.divide_aff af1 af2 subnoise2)) (perturb (evalBinop Div vR1 vR2) REAL 0) (updMap (updMap ihmap2 subnoise2 qInv) (subnoise2 + 1) qMult))
by (unfold perturb; simpl evalBinop; rewrite afQ2R_divide_aff; auto). by (unfold perturb; simpl evalBinop; rewrite afQ2R_divide_aff; auto).
exists (updMap (updMap ihmap2 subnoise2 qInv) (subnoise2 + 1) qMult), exists (updMap (updMap ihmap2 subnoise2 qInv) (subnoise2 + 1) qMult),
...@@ -1954,9 +1957,10 @@ Proof. ...@@ -1954,9 +1957,10 @@ Proof.
apply Hsubmapvalid3. apply Hsubmapvalid3.
lia. lia.
} }
assert (eval_expr E (toRMap Gamma) (toREval (toRExp (Fma e1 e2 e3))) (perturb (evalFma vR1 vR2 vR3)REAL 0) REAL) assert (eval_expr E (toRMap Gamma) fBits (toREval (toRExp (Fma e1 e2 e3))) (perturb (evalFma vR1 vR2 vR3)REAL 0) REAL).
by (replace REAL with (join3 REAL REAL REAL) by trivial; { eapply Fma_dist'; eauto; try congruence.
apply Fma_dist; try rewrite Rabs_R0; auto; simpl; lra). - rewrite Rabs_R0; cbn; lra.
- intros. cbn in *. contradiction. }
assert (af_evals (afQ2R (AffineArithQ.plus_aff af1 (AffineArithQ.mult_aff af2 af3 subnoise3))) (perturb (evalFma vR1 vR2 vR3) REAL 0) (updMap ihmap3 subnoise3 qMult)). assert (af_evals (afQ2R (AffineArithQ.plus_aff af1 (AffineArithQ.mult_aff af2 af3 subnoise3))) (perturb (evalFma vR1 vR2 vR3) REAL 0) (updMap ihmap3 subnoise3 qMult)).
{ {
unfold perturb. unfold perturb.
...@@ -2142,6 +2146,7 @@ Proof. ...@@ -2142,6 +2146,7 @@ Proof.
* rewrite FloverMapFacts.P.F.add_neq_o in Hsome; auto. * rewrite FloverMapFacts.P.F.add_neq_o in Hsome; auto.
apply checked_expressions_flover_map_add_compat; auto. apply checked_expressions_flover_map_add_compat; auto.
apply visitedSubexpr; eauto. apply visitedSubexpr; eauto.
Unshelve. all:exact 0%nat.
Qed. Qed.
Fixpoint validAffineBoundsCmd (c: cmd Q) (A: analysisResult) (P: precond) (validVars: NatSet.t) Fixpoint validAffineBoundsCmd (c: cmd Q) (A: analysisResult) (P: precond) (validVars: NatSet.t)
...@@ -2164,24 +2169,24 @@ Fixpoint validAffineBoundsCmd (c: cmd Q) (A: analysisResult) (P: precond) (valid ...@@ -2164,24 +2169,24 @@ Fixpoint validAffineBoundsCmd (c: cmd Q) (A: analysisResult) (P: precond) (valid
| Ret e => validAffineBounds e A P validVars exprsAf currentMaxNoise | Ret e => validAffineBounds e A P validVars exprsAf currentMaxNoise
end. end.
Lemma eval_expr_ssa_extension (e: expr R) (e' : expr Q) E Gamma vR vR' m n c fVars dVars outVars: Lemma eval_expr_ssa_extension (e: expr R) (e' : expr Q) E Gamma fBits vR vR' m n c fVars dVars outVars:
ssa (Let m n e' c) (fVars dVars) outVars -> ssa (Let m n e' c) (fVars dVars) outVars ->
NatSet.Subset (usedVars e) (fVars dVars) -> NatSet.Subset (usedVars e) (fVars dVars) ->
~ (n fVars dVars) -> ~ (n fVars dVars) ->
eval_expr E Gamma e vR REAL -> eval_expr E Gamma fBits e vR REAL ->
eval_expr (updEnv n vR' E) (updDefVars n REAL Gamma) e vR REAL. eval_expr (updEnv n vR' E) (updDefVars n REAL Gamma) fBits e vR REAL.
Proof. Proof.
intros Hssa Hsub Hnotin Heval. intros Hssa Hsub Hnotin Heval.
eapply eval_expr_ignore_bind; [auto |]. eapply eval_expr_ignore_bind; [auto |].
edestruct ssa_inv_let; eauto. edestruct ssa_inv_let; eauto.
Qed. Qed.
Lemma validRanges_ssa_extension (e: expr Q) (e' : expr Q) A E Gamma vR' m n c fVars dVars outVars: Lemma validRanges_ssa_extension (e: expr Q) (e' : expr Q) A E Gamma fBits vR' m n c fVars dVars outVars:
ssa (Let m n e' c) (fVars dVars) outVars -> ssa (Let m n e' c) (fVars dVars) outVars ->
NatSet.Subset (usedVars e) (fVars dVars) -> NatSet.Subset (usedVars e) (fVars dVars) ->
~ (n fVars dVars) -> ~ (n fVars dVars) ->
validRanges e A E Gamma -> validRanges e A E Gamma fBits ->
validRanges e A (updEnv n vR' E) (updDefVars n REAL Gamma). validRanges e A (updEnv n vR' E) (updDefVars n REAL Gamma) fBits.
Proof. Proof.
intros Hssa Hsub Hnotin Hranges. intros Hssa Hsub Hnotin Hranges.
induction e. induction e.
...@@ -2251,10 +2256,10 @@ Proof. ...@@ -2251,10 +2256,10 @@ Proof.
rewrite usedVars_toREval_toRExp_compat; auto. rewrite usedVars_toREval_toRExp_compat; auto.
Qed. Qed.
Lemma validAffineBoundsCmd_sound (c: cmd Q) (A: analysisResult) (P: precond) Lemma validAffineBoundsCmd_sound (c: cmd Q) (A: analysisResult) (P: precond) fBits
fVars dVars outVars (E: env) Gamma exprAfs noise iexpmap inoise map1: fVars dVars outVars (E: env) Gamma exprAfs noise iexpmap inoise map1:
(forall e, (exists af, FloverMap.find e iexpmap = Some af) -> (forall e, (exists af, FloverMap.find e iexpmap = Some af) ->
checked_expressions A E Gamma fVars dVars e iexpmap inoise map1) -> checked_expressions A E Gamma fBits fVars dVars e iexpmap inoise map1) ->
(inoise > 0)%nat -> (inoise > 0)%nat ->
(forall n, (n >= inoise)%nat -> map1 n = None) -> (forall n, (n >= inoise)%nat -> map1 n = None) ->
validAffineBoundsCmd c A P dVars iexpmap inoise = Some (exprAfs, noise) -> validAffineBoundsCmd c A P dVars iexpmap inoise = Some (exprAfs, noise) ->
...@@ -2272,12 +2277,12 @@ Lemma validAffineBoundsCmd_sound (c: cmd Q) (A: analysisResult) (P: precond) ...@@ -2272,12 +2277,12 @@ Lemma validAffineBoundsCmd_sound (c: cmd Q) (A: analysisResult) (P: precond)
fresh noise af /\ fresh noise af /\
(forall n, (n >= noise)%nat -> map2 n = None) /\ (forall n, (n >= noise)%nat -> map2 n = None) /\
(noise >= inoise)%nat /\ (noise >= inoise)%nat /\
bstep (toREvalCmd (toRCmd c)) E (toRMap Gamma) vR REAL /\ bstep (toREvalCmd (toRCmd c)) E (toRMap Gamma) fBits vR REAL /\
validRangesCmd c A E Gamma /\ validRangesCmd c A E Gamma fBits /\
af_evals (afQ2R af) vR map2 /\ af_evals (afQ2R af) vR map2 /\
(forall e, FloverMap.find e iexpmap = None -> (forall e, FloverMap.find e iexpmap = None ->
(exists af, FloverMap.find e exprAfs = Some af) -> (exists af, FloverMap.find e exprAfs = Some af) ->
exists E' Gamma' dVars, checked_expressions A E' Gamma' fVars dVars e exprAfs noise map2). exists E' Gamma' dVars, checked_expressions A E' Gamma' fBits fVars dVars e exprAfs noise map2).
Proof. Proof.
revert E Gamma dVars iexpmap inoise exprAfs noise map1. revert E Gamma dVars iexpmap inoise exprAfs noise map1.
induction c; intros * visitedExpr Hnoise Hmapvalid valid_bounds_cmd induction c; intros * visitedExpr Hnoise Hmapvalid valid_bounds_cmd
......
...@@ -12,9 +12,10 @@ From Flover ...@@ -12,9 +12,10 @@ From Flover
Require Export Infra.ExpressionAbbrevs Flover.Commands Coq.QArith.QArith. Require Export Infra.ExpressionAbbrevs Flover.Commands Coq.QArith.QArith.
(** Certificate checking function **) (** Certificate checking function **)
Definition CertificateChecker (e:expr Q) (absenv:analysisResult) (P:precond) (defVars:nat -> option mType) := Definition CertificateChecker (e:expr Q) (absenv:analysisResult)
let tMap := (typeMap defVars e (FloverMap.empty mType)) in (P:precond) (defVars:nat -> option mType) (fBits:FloverMap.t nat):=
if (typeCheck e defVars tMap) let tMap := (typeMap defVars e (FloverMap.empty mType) fBits) in
if (typeCheck e defVars tMap fBits)
then then
if RangeValidator e absenv P NatSet.empty && FPRangeValidator e absenv tMap NatSet.empty if RangeValidator e absenv P NatSet.empty && FPRangeValidator e absenv tMap NatSet.empty
then RoundoffErrorValidator e tMap absenv NatSet.empty then RoundoffErrorValidator e tMap absenv NatSet.empty
...@@ -26,7 +27,8 @@ Definition CertificateChecker (e:expr Q) (absenv:analysisResult) (P:precond) (de ...@@ -26,7 +27,8 @@ Definition CertificateChecker (e:expr Q) (absenv:analysisResult) (P:precond) (de
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:expr Q) (absenv:analysisResult) P defVars: Theorem Certificate_checking_is_sound (e:expr Q) (absenv:analysisResult) P
defVars fBits:
forall (E1 E2:env), forall (E1 E2:env),
approxEnv E1 defVars absenv (usedVars e) NatSet.empty E2 -> approxEnv E1 defVars absenv (usedVars e) NatSet.empty E2 ->
(forall v, NatSet.In v (Expressions.usedVars e) -> (forall v, NatSet.In v (Expressions.usedVars e) ->
...@@ -35,13 +37,13 @@ Theorem Certificate_checking_is_sound (e:expr Q) (absenv:analysisResult) P defVa ...@@ -35,13 +37,13 @@ Theorem Certificate_checking_is_sound (e:expr Q) (absenv:analysisResult) P defVa
(forall v, NatSet.In v (usedVars e) -> (forall v, NatSet.In v (usedVars e) ->
exists m : mType, exists m : mType,
defVars v = Some m) -> defVars v = Some m) ->
CertificateChecker e absenv P defVars = true -> CertificateChecker e absenv P defVars fBits = true ->
exists iv err vR vF m, exists iv err vR vF m,
FloverMap.find e absenv = Some (iv, err) /\ FloverMap.find e absenv = Some (iv, err) /\
eval_expr E1 (toRMap defVars) (toREval (toRExp e)) vR REAL /\ eval_expr E1 (toRMap defVars) (toRBMap fBits) (toREval (toRExp e)) vR REAL /\
eval_expr E2 defVars (toRExp e) vF m /\ eval_expr E2 defVars (toRBMap fBits) (toRExp e) vF m /\
(forall vF m, (forall vF m,
eval_expr E2 defVars (toRExp e) vF m -> eval_expr E2 defVars (toRBMap fBits) (toRExp e) vF m ->
(Rabs (vR - vF) <= Q2R err))%R. (Rabs (vR - vF) <= Q2R err))%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
...@@ -68,19 +70,20 @@ Proof. ...@@ -68,19 +70,20 @@ Proof.
{ unfold vars_typed. intros; apply types_defined. set_tac. destruct H1; set_tac. { unfold vars_typed. intros; apply types_defined. set_tac. destruct H1; set_tac.
split; try auto. hnf; intros; set_tac. } split; try auto. hnf; intros; set_tac. }
rename R into validFPRanges. rename R into validFPRanges.
assert (validRanges e absenv E1 defVars) as valid_e. assert (validRanges e absenv E1 defVars (toRBMap fBits)) as valid_e.
{ eapply (RangeValidator_sound e (dVars:=NatSet.empty) (A:=absenv) (P:=P) (Gamma:=defVars) (E:=E1)); { eapply (RangeValidator_sound e (dVars:=NatSet.empty) (A:=absenv) (P:=P) (Gamma:=defVars) (E:=E1));
auto. } auto. }
pose proof (validRanges_single _ _ _ _ valid_e) as valid_single; pose proof (validRanges_single _ _ _ _ _ valid_e) as valid_single;
destruct valid_single as [iv_e [ err_e [vR [ map_e [eval_real real_bounds_e]]]]]. destruct valid_single as [iv_e [ err_e [vR [ map_e [eval_real real_bounds_e]]]]].
destruct iv_e as [elo ehi]. destruct iv_e as [elo ehi].
edestruct (RoundoffErrorValidator_sound e (typeMap defVars e (FloverMap.empty mType)) L approxE1E2 H0 eval_real R0 valid_e H1 map_e) as [[vF [mF eval_float]] err_bounded]; auto. edestruct (RoundoffErrorValidator_sound e (typeMap defVars e (FloverMap.empty mType) fBits) L approxE1E2 H0 eval_real R0 valid_e H1 map_e) as [[vF [mF eval_float]] err_bounded]; auto.
exists (elo, ehi), err_e, vR, vF, mF; split; auto. exists (elo, ehi), err_e, vR, vF, mF; split; auto.
Qed. Qed.
Definition CertificateCheckerCmd (f:cmd Q) (absenv:analysisResult) (P:precond) defVars:= Definition CertificateCheckerCmd (f:cmd Q) (absenv:analysisResult) (P:precond)
let tMap := typeMapCmd defVars f (FloverMap.empty mType) in defVars fBits:=
if (typeCheckCmd f defVars tMap && validSSA f (freeVars f)) let tMap := typeMapCmd defVars f (FloverMap.empty mType) fBits in
if (typeCheckCmd f defVars tMap fBits && validSSA f (freeVars f))
then then
if (RangeValidatorCmd f absenv P NatSet.empty) && if (RangeValidatorCmd f absenv P NatSet.empty) &&
FPRangeValidatorCmd f absenv tMap NatSet.empty FPRangeValidatorCmd f absenv tMap NatSet.empty
...@@ -88,7 +91,8 @@ Definition CertificateCheckerCmd (f:cmd Q) (absenv:analysisResult) (P:precond) d ...@@ -88,7 +91,8 @@ Definition CertificateCheckerCmd (f:cmd Q) (absenv:analysisResult) (P:precond) d
else false else false
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 fBits:
forall (E1 E2:env), 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.In v (freeVars f) -> (forall v, NatSet.In v (freeVars f) ->
...@@ -97,13 +101,13 @@ Theorem Certificate_checking_cmds_is_sound (f:cmd Q) (absenv:analysisResult) P d ...@@ -97,13 +101,13 @@ Theorem Certificate_checking_cmds_is_sound (f:cmd Q) (absenv:analysisResult) P d
(forall v, NatSet.In v (freeVars f) -> (forall v, NatSet.In v (freeVars f) ->
exists m : mType, exists m : mType,
defVars v = Some m) -> defVars v = Some m) ->
CertificateCheckerCmd f absenv P defVars = true -> CertificateCheckerCmd f absenv P defVars fBits = true ->
exists iv err vR vF m, exists iv err vR vF m,
FloverMap.find (getRetExp f) absenv = Some (iv,err) /\ FloverMap.find (getRetExp f) absenv = Some (iv,err) /\
bstep (toREvalCmd (toRCmd f)) E1 (toRMap defVars) vR REAL /\ bstep (toREvalCmd (toRCmd f)) E1 (toRMap defVars) (toRBMap fBits) vR REAL /\
bstep (toRCmd f) E2 defVars vF m /\ bstep (toRCmd f) E2 defVars (toRBMap fBits) vF m /\
(forall vF m, (forall vF m,
bstep (toRCmd f) E2 defVars vF m -> bstep (toRCmd f) E2 defVars (toRBMap fBits) vF m ->
(Rabs (vR - vF) <= Q2R (err))%R). (Rabs (vR - vF) <= Q2R (err))%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
...@@ -129,11 +133,11 @@ Proof. ...@@ -129,11 +133,11 @@ Proof.
destruct H0; set_tac. } destruct H0; set_tac. }
assert (NatSet.Subset (freeVars f -- NatSet.empty) (freeVars f)) assert (NatSet.Subset (freeVars f -- NatSet.empty) (freeVars f))
as freeVars_contained by set_tac. as freeVars_contained by set_tac.
assert (validRangesCmd f absenv E1 defVars) as valid_f. assert (validRangesCmd f absenv E1 defVars (toRBMap fBits)) as valid_f.
{ eapply RangeValidatorCmd_sound; eauto. { eapply RangeValidatorCmd_sound; eauto.
unfold affine_dVars_range_valid; intros. unfold affine_dVars_range_valid; intros.
set_tac. } set_tac. }
pose proof (validRangesCmd_single _ _ _ _ valid_f) as valid_single. pose proof (validRangesCmd_single _ _ _ _ _ valid_f) as valid_single.
destruct valid_single as [iv [ err [vR [map_f [eval_real bounded_real_f]]]]]. destruct valid_single as [iv [ err [vR [map_f [eval_real bounded_real_f]]]]].
destruct iv as [f_lo f_hi]. destruct iv as [f_lo f_hi].
edestruct (RoundoffErrorValidatorCmd_sound) as [[vF [mF eval_float]] ?]; eauto. edestruct (RoundoffErrorValidatorCmd_sound) as [[vF [mF eval_float]] ?]; eauto.
......
...@@ -49,14 +49,14 @@ Inductive sstep : cmd R -> env -> R -> cmd R -> env -> Prop := ...@@ -49,14 +49,14 @@ Inductive sstep : cmd R -> env -> R -> cmd R -> env -> Prop :=
Define big step semantics for the Flover language, terminating on a "returned" Define big step semantics for the Flover language, terminating on a "returned"
result value result value
**) **)
Inductive bstep : cmd R -> env -> (nat -> option mType) -> R -> mType -> Prop := Inductive bstep : cmd R -> env -> (nat -> option mType) -> (expr R -> option nat) -> 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 fBits: