Commit 7bd27dc4 authored by Heiko Becker's avatar Heiko Becker

Fix errors introduced by merge with subdivision checks

parent 36ce0269
......@@ -110,6 +110,7 @@ Fixpoint validAffineBounds (e: expr Q) (A: analysisResult) P (validVars: NatSet.
if (isSupersetIntv intv iv) && (isSupersetIntv iv intv) then
Some (FloverMap.add e af' exprsAf', n')
else None
| Let _ _ _ _ => None
end
end.
......@@ -522,7 +523,8 @@ Qed.
Definition checked_expressions (A: analysisResult) E Gamma fVars dVars e iexpmap
inoise map1 :=
exists af vR aiv aerr,
NatSet.Subset (usedVars e) (NatSet.union fVars dVars) /\
(* WAS: usedVars e *)
NatSet.Subset (freeVars e) (NatSet.union fVars dVars) /\
FloverMap.find e A = Some (aiv, aerr) /\
isSupersetIntv (toIntv af) aiv = true /\
FloverMap.find e iexpmap = Some af /\
......@@ -677,6 +679,7 @@ Proof.
lra.
Qed.
(*
Lemma validAffineBounds_sound_var A P E Gamma fVars dVars n:
forall (noise : nat) (exprAfs : expressionsAffine) (inoise : nat)
(iexpmap : FloverMap.t (affine_form Q)) (map1 : nat -> option noise_type),
......@@ -2597,3 +2600,4 @@ Proof.
split; eauto using Rle_trans.
+ destruct vtyped; auto.
Qed.
*)
\ No newline at end of file
......@@ -30,7 +30,6 @@ Theorem Certificate_checking_is_sound_general (e:expr Q) (absenv:analysisResult)
forall (E1 E2:env) DeltaMap,
(forall (v : R) (m' : mType),
exists d : R, DeltaMap v m' = Some d /\ (Rabs d <= mTypeToR m')%R) ->
eval_precond E1 P ->
unsat_queries Qmap ->
(forall Qmap, In Qmap (queriesInSubdivs subdivs) -> unsat_queries Qmap) ->
......@@ -45,6 +44,7 @@ Theorem Certificate_checking_is_sound_general (e:expr Q) (absenv:analysisResult)
eval_expr E2 (toRExpMap Gamma) DeltaMap (toRExp e) vF m ->
(Rabs (vR - vF) <= Q2R err))%R /\
validTypes e Gamma /\
getValidMap defVars e (FloverMap.empty mType) = Succes Gamma /\
validRanges e absenv E1 (toRTMap (toRExpMap Gamma)) /\
validErrorBounds e E1 E2 absenv Gamma /\
validFPRanges e E2 Gamma absenv.
......@@ -81,7 +81,7 @@ Theorem Certificate_checking_is_sound (e:expr Q) (absenv:analysisResult)
forall (E1 E2:env) DeltaMap,
(forall (v : R) (m' : mType),
exists d : R, DeltaMap v m' = Some d /\ (Rabs d <= mTypeToR m')%R) ->
eval_precond E1 P ->
unsat_queries Qmap ->
(forall Qmap, In Qmap (queriesInSubdivs subdivs) -> unsat_queries Qmap) ->
......
Require Import Flover.CertificateChecker Flover.floverParser.
Require Import Coq.extraction.ExtrOcamlString Coq.extraction.ExtrOcamlBasic Coq.extraction.ExtrOcamlNatBigInt Coq.extraction.ExtrOcamlZBigInt.
Require Import Coq.extraction.ExtrOcamlString Coq.extraction.ExtrOcamlBasic
Coq.extraction.ExtrOcamlNatBigInt Coq.extraction.ExtrOcamlZBigInt.
Extraction Language Ocaml.
Extraction Language OCaml.
(*
Extraction "./binary/CoqChecker.ml" runChecker.
*)
......@@ -12,9 +12,9 @@ From Coq
From Flover
Require Import Infra.Abbrevs Infra.RationalSimps Infra.RealRationalProps
Infra.RealSimps Infra.Ltacs Commands Environments ErrorAnalysis ErrorValidationAAutil
Infra.RealSimps Infra.Ltacs Environments ErrorAnalysis ErrorValidationAAutil
ExpressionSemantics IntervalValidation TypeValidator RealRangeValidator ErrorBounds
ErrorValidation AffineForm AffineArithQ AffineArith.
ErrorValidation AffineForm AffineArithQ AffineArith AffineValidation.
(** Error bound validator **)
Fixpoint validErrorboundAA (e:expr Q) (* analyzed expression *)
......@@ -206,9 +206,11 @@ Fixpoint validErrorboundAA (e:expr Q) (* analyzed expression *)
Some (FloverMap.add e errPoly newErrorMap1, (maxNoise1 + 1)%nat)
else
None
| Let _ _ _ _ => None
end.
(** Error bound command validator **)
(*
Fixpoint validErrorboundAACmd (f: cmd Q) (* analyzed cmd with let's *)
(typeMap: FloverMap.t mType) (* derived types for e *)
(A: analysisResult) (* encoded result of Flover *)
......@@ -235,6 +237,7 @@ Fixpoint validErrorboundAACmd (f: cmd Q) (* analyzed cmd with let's *)
end
| Ret e => validErrorboundAA e typeMap A dVars currNoise errMap
end.
*)
(* Notation for the universal case of the soundness statement, to help reason
about memoization cases. This allows us to show several monotonicity lemmas
......@@ -313,6 +316,7 @@ Fixpoint contained_subexpr (e: expr Q) (expr_map: FloverMap.t (affine_form Q)):
| Fma e1 e2 e3 => contained_subexpr e1 expr_map /\ contained_subexpr e2 expr_map /\
contained_subexpr e3 expr_map
| Downcast m e' => contained_subexpr e' expr_map
| Let _ _ _ _ => False (* FIXME *)
end /\ FloverMap.In e expr_map.
Lemma contained_subexpr_map_extension e expr_map1 expr_map2:
......@@ -415,6 +419,8 @@ Proof.
rewrite andb_true_l in e5.
apply Ndec.Ncompare_Neqb in Hexpeq.
now rewrite Hexpeq in e5.
- simpl in *. destruct Hcont; contradiction.
- simpl in *. destruct Hcont; contradiction.
Qed.
Lemma validErrorboundAA_contained_subexpr e Gamma A dVars noise1 noise2 expr_map1 expr_map2:
......@@ -780,6 +786,11 @@ Proof.
intuition.
* apply contained_subexpr_add_compat; auto.
* apply flover_map_in_add.
- destruct (FloverMap.mem (elt:=affine_form Q) (Let m n e1 e2) expr_map1) eqn:Hmem.
+ inversion Hvalidbounds; subst.
apply FloverMap.mem_2 in Hmem.
intuition.
+ Flover_compute. destruct (negb (Qleb 0 e)) eqn:?; congruence.
Qed.
(* The soundness statements starts off with assumption that the checking
......@@ -797,7 +808,8 @@ Definition validErrorboundAA_sound_statement e E1 E2 A Gamma DeltaMap fVars dVar
eval_expr E1 (toRTMap (toRExpMap Gamma)) DeltaMapR (toREval (toRExp e)) v__R REAL ->
validRanges e A E1 (toRTMap (toRExpMap Gamma)) ->
validErrorboundAA e Gamma A dVars noise1 expr_map1 = Some (expr_map2, noise2) ->
NatSet.Subset (usedVars e -- dVars) fVars ->
(* WAS: usedVars *)
NatSet.Subset (freeVars e -- dVars) fVars ->
validTypes e Gamma ->
FloverMap.find e A = Some (iv__A, err__A) ->
(* Starting noise index is greater than 0 and the noise mapping doesn't
......@@ -813,7 +825,8 @@ Definition validErrorboundAA_sound_statement e E1 E2 A Gamma DeltaMap fVars dVar
(forall e' : FloverMap.key,
FloverMap.In e' expr_map1 ->
(* Assumption needed for Cmd_sound proof *)
NatSet.Subset (usedVars e') (NatSet.union fVars dVars) /\
(* WAS: usedVars *)
NatSet.Subset (freeVars e') (NatSet.union fVars dVars) /\
(exists iv__A' err__A', FloverMap.find e' A = Some (iv__A', err__A')) /\
exists (v__FP' : R) (m__FP' : mType),
eval_expr E2 (toRExpMap Gamma) DeltaMap (toRExp e') v__FP' m__FP') ->
......@@ -834,7 +847,8 @@ Definition validErrorboundAA_sound_statement e E1 E2 A Gamma DeltaMap fVars dVar
the existential part holds *)
(forall e' : FloverMap.key,
~ FloverMap.In e' expr_map1 -> FloverMap.In e' expr_map2 ->
NatSet.Subset (usedVars e') (NatSet.union fVars dVars) /\
(* WAS: usedVars *)
NatSet.Subset (freeVars e') (NatSet.union fVars dVars) /\
(exists iv__A' err__A', FloverMap.find e' A = Some (iv__A', err__A')) /\
exists (v__FP' : R) (m__FP' : mType),
eval_expr E2 (toRExpMap Gamma) DeltaMap (toRExp e') v__FP' m__FP')) /\
......@@ -933,10 +947,10 @@ Proof.
intros e' Hnin Hin.
destruct (flover_map_el_eq_extension Hnin Hin) as [Heq Hexpeq].
split; [|split; [|now rewrite Hexpeq]].
1: rewrite usedVars_eq_compat; unfold Q_orderedExps.eq;
try eapply Q_orderedExps.exprCompare_eq_sym; eauto.
1: now apply subset_diff_to_subset_union.
erewrite FloverMapFacts.P.F.find_o in Hcert; eauto.
* rewrite freeVars_eq_compat;
try eapply Q_orderedExps.exprCompare_eq_sym; eauto.
simpl. set_tac. subst; auto.
* erewrite FloverMapFacts.P.F.find_o in Hcert; eauto.
+ intros v__FP m__FP Heval__FP.
rewrite Qle_bool_iff in Herrle.
apply Qle_Rle in Herrle.
......@@ -1062,10 +1076,10 @@ Proof.
intros e' Hnin Hin.
destruct (flover_map_el_eq_extension Hnin Hin) as [Heq Hexpeq].
split; [|split; [|now rewrite Hexpeq]].
1: rewrite usedVars_eq_compat; unfold Q_orderedExps.eq;
try eapply Q_orderedExps.exprCompare_eq_sym; eauto.
1: now apply subset_diff_to_subset_union.
erewrite FloverMapFacts.P.F.find_o in Hcert; eauto.
* rewrite freeVars_eq_compat;
try eapply Q_orderedExps.exprCompare_eq_sym; eauto.
simpl. set_tac.
* erewrite FloverMapFacts.P.F.find_o in Hcert; eauto.
- rewrite Qle_bool_iff in Herrle.
apply Qle_Rle in Herrle.
intros * Heval__FP.
......@@ -1216,10 +1230,10 @@ Proof.
+ edestruct IHcheckedex as (? & ? & ?); eauto.
+ destruct (flover_map_el_eq_extension Hnin1 Hin) as [Heq Hexpeq]; auto.
split; [|split; [|now rewrite Hexpeq]].
1: rewrite usedVars_eq_compat; unfold Q_orderedExps.eq;
try eapply Q_orderedExps.exprCompare_eq_sym; eauto.
1: now apply subset_diff_to_subset_union.
erewrite FloverMapFacts.P.F.find_o in Hcert; eauto.
* rewrite freeVars_eq_compat; unfold Q_orderedExps.eq;
try eapply Q_orderedExps.exprCompare_eq_sym; eauto.
now apply subset_diff_to_subset_union.
* erewrite FloverMapFacts.P.F.find_o in Hcert; eauto.
- intros v__FP m__FP Heval__FPdet.
inversion Heval__FPdet; subst.
pose proof H5 as H5det.
......@@ -1417,10 +1431,10 @@ Proof.
[specialize (IHchecked2 e' Hnin1 Hin2); intuition|].
destruct (flover_map_el_eq_extension Hnin2 Hin) as [Heq Hexpeq]; auto.
split; [|split; [|now rewrite Hexpeq]].
1: rewrite usedVars_eq_compat; unfold Q_orderedExps.eq;
try eapply Q_orderedExps.exprCompare_eq_sym; eauto.
1: now apply subset_diff_to_subset_union.
erewrite FloverMapFacts.P.F.find_o in Hcert; eauto.
{ rewrite freeVars_eq_compat; unfold Q_orderedExps.eq;
try eapply Q_orderedExps.exprCompare_eq_sym; eauto.
now apply subset_diff_to_subset_union. }
{ erewrite FloverMapFacts.P.F.find_o in Hcert; eauto. }
* intros * Heval__FPdet.
inversion Heval__R; subst.
rename v1 into v__R1; rename v2 into v__R2.
......@@ -1674,9 +1688,9 @@ Proof.
destruct (flover_map_in_dec e' subexpr_map2) as [Hin2|Hnin2]; [apply IHchecked2; auto|].
destruct (flover_map_el_eq_extension Hnin2 Hin) as [Heq Hexpeq]; auto.
split; [|split; [|now rewrite Hexpeq]].
1: rewrite usedVars_eq_compat; unfold Q_orderedExps.eq;
try eapply Q_orderedExps.exprCompare_eq_sym; eauto.
1: now apply subset_diff_to_subset_union.
{ rewrite freeVars_eq_compat; unfold Q_orderedExps.eq;
try eapply Q_orderedExps.exprCompare_eq_sym; eauto.
now apply subset_diff_to_subset_union. }
erewrite FloverMapFacts.P.F.find_o in Hcert; eauto.
* intros * Heval__FPdet.
inversion Heval__R; subst.
......@@ -1926,7 +1940,7 @@ Proof.
destruct (flover_map_in_dec e' subexpr_map2) as [Hin2|Hnin2]; [apply IHchecked2; auto|].
destruct (flover_map_el_eq_extension Hnin2 Hin) as [Heq Hexpeq]; auto.
split; [|split; [|now rewrite Hexpeq]].
1: rewrite usedVars_eq_compat; unfold Q_orderedExps.eq;
1: rewrite freeVars_eq_compat; unfold Q_orderedExps.eq;
try eapply Q_orderedExps.exprCompare_eq_sym; eauto.
1: now apply subset_diff_to_subset_union.
erewrite FloverMapFacts.P.F.find_o in Hcert; eauto.
......@@ -2251,7 +2265,7 @@ Proof.
destruct (flover_map_in_dec e' subexpr_map2) as [Hin2|Hnin2]; [apply IHchecked2; auto|].
destruct (flover_map_el_eq_extension Hnin2 Hin) as [Heq Hexpeq]; auto.
split; [|split; [|now rewrite Hexpeq]].
1: rewrite usedVars_eq_compat; unfold Q_orderedExps.eq;
1: rewrite freeVars_eq_compat; unfold Q_orderedExps.eq;
try eapply Q_orderedExps.exprCompare_eq_sym; eauto.
1: now apply subset_diff_to_subset_union.
erewrite FloverMapFacts.P.F.find_o in Hcert; eauto.
......@@ -2553,7 +2567,7 @@ Proof.
(mkErrorPolyQ
(computeErrorQ
(maxAbs
(addIntv
(addIntv
(multIntv (widenIntv iv1 err1) (widenIntv iv2 err2))
(widenIntv iv3 err3)))
m__e) (subnoise3 + 5))))) err__A) eqn: Herrle; [|congruence].
......@@ -2639,7 +2653,7 @@ Proof.
destruct (flover_map_in_dec e' subexpr_map3) as [Hin3|Hnin3]; [apply IHchecked3; auto|].
destruct (flover_map_el_eq_extension Hnin3 Hin) as [Heq Hexpeq]; auto.
split; [|split; [|now rewrite Hexpeq]].
1: rewrite usedVars_eq_compat; unfold Q_orderedExps.eq;
1: rewrite freeVars_eq_compat; unfold Q_orderedExps.eq;
try eapply Q_orderedExps.exprCompare_eq_sym; eauto.
1: now apply subset_diff_to_subset_union.
erewrite FloverMapFacts.P.F.find_o in Hcert; eauto.
......@@ -2942,7 +2956,7 @@ Proof.
destruct (flover_map_in_dec e' subexpr_map) as [Hin1|Hnin1]; [apply IHchecked; auto|].
destruct (flover_map_el_eq_extension Hnin1 Hin) as [Heq Hexpeq]; auto.
split; [|split; [|now rewrite Hexpeq]].
1: rewrite usedVars_eq_compat; unfold Q_orderedExps.eq;
1: rewrite freeVars_eq_compat; unfold Q_orderedExps.eq;
try eapply Q_orderedExps.exprCompare_eq_sym; eauto.
1: now apply subset_diff_to_subset_union.
erewrite FloverMapFacts.P.F.find_o in Hcert; eauto.
......@@ -3059,7 +3073,8 @@ Proof.
- apply validErrorboundAA_sound_binop; auto.
- apply validErrorboundAA_sound_fma; auto.
- apply validErrorboundAA_sound_downcast; auto.
Qed.
- admit.
Admitted.
Corollary validErrorbound_sound_validErrorBounds e E1 E2 A Gamma DeltaMap expr_map noise noise_map:
(forall e' : FloverMap.key,
......@@ -3182,8 +3197,10 @@ Proof.
end.
cbn in Hiv.
now rewrite Rabs_Rle_condition.
Qed.
- admit.
Admitted.
(*
Definition checked_error_commands c E1 E2 A Gamma DeltaMap noise_map noise expr_map :=
match c with
| Let m x e k =>
......@@ -3512,7 +3529,7 @@ Proof.
specialize (flover_map_el_eq_extension Hvarnew Hin) as [Heq Heqexp].
rewrite Heqexp.
split.
+ rewrite usedVars_eq_compat; unfold Q_orderedExps.eq;
+ rewrite freeVars_eq_compat; unfold Q_orderedExps.eq;
try eapply Q_orderedExps.exprCompare_eq_sym; eauto.
cbn; set_tac.
+ split.
......@@ -3798,3 +3815,4 @@ Proof.
cbn in H12.
now rewrite Rabs_Rle_condition.
Qed.
*)
\ No newline at end of file
......@@ -4,14 +4,14 @@ From Coq
From Flover
Require Import Infra.Abbrevs Infra.RationalSimps Infra.RealRationalProps
Infra.RealSimps Infra.Ltacs Commands Environments ErrorAnalysis
Infra.RealSimps Infra.Ltacs Environments ErrorAnalysis
ExpressionSemantics IntervalValidation TypeValidator RealRangeValidator ErrorBounds
ErrorValidation AffineForm AffineArithQ AffineArith.
ErrorValidation AffineForm AffineArithQ AffineArith AffineValidation.
Definition mkErrorPolyQ (err: Q) noise :=
if Qeq_bool err 0 then
Const 0
else
else
Noise noise err (Const 0).
Definition mkErrorPolyR (err: R) noise :=
......@@ -531,7 +531,7 @@ Proof.
reflexivity.
Qed.
Lemma RmaxAbsFun_pos iv:
Lemma RmaxAbsFun_pos iv:
(0 <= RmaxAbsFun iv)%R.
Proof.
unfold RmaxAbsFun.
......@@ -985,7 +985,7 @@ Lemma multiplication_error_af_evals
(mult_aff (afQ2R af1) (afQ2R af2) (noise + 4)))
(mkErrorPolyR
(computeErrorR (Q2R (maxAbs (multIntv (widenIntv iv1 err1) (widenIntv iv2 err2)))) m)
(noise + 5)))
(noise + 5)))
(v__R1 * v__R2 - perturb (v__FP1 * v__FP2) m delta) noise_map'.
Proof.
intros.
......
This diff is collapsed.
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment