Commit 92da81e9 authored by Heiko Becker's avatar Heiko Becker

Port Error validator to finite maps, some proof simplification in interval validator

parent 41b255c9
......@@ -6,23 +6,21 @@
encoded in the analysis result. The validator is used in the file
CertificateChecker.v to build the complete checker.
**)
Require Import Coq.QArith.QArith Coq.QArith.Qminmax Coq.QArith.Qabs
Coq.QArith.Qreals Coq.micromega.Psatz Coq.Reals.Reals.
Require Import Daisy.Infra.Abbrevs Daisy.Infra.RationalSimps
Daisy.Infra.RealRationalProps Daisy.Infra.RealSimps
Daisy.Infra.Ltacs Daisy.Environments
Daisy.IntervalValidation Daisy.Typing Daisy.ErrorBounds.
From Coq
Require Import QArith.QArith QArith.Qminmax QArith.Qabs QArith.Qreals
micromega.Psatz Reals.Reals.
From Daisy
Require Import Infra.Abbrevs Infra.RationalSimps Infra.RealRationalProps
Infra.RealSimps Infra.Ltacs Environments IntervalValidation Typing
ErrorBounds.
(** Error bound validator **)
Fixpoint validErrorbound (e:exp Q) (* analyzed expression *)
(typeMap:exp Q -> option mType) (* derived types for e *)
(typeMap:DaisyMap.t mType) (* derived types for e *)
(A:analysisResult) (* encoded result of Daisy *)
(dVars:NatSet.t) (* let-bound variables encountered previously *):=
let (intv, err) := (A e) in
let mopt := typeMap e in
match mopt with
| None => false
| Some m =>
match DaisyMap.find e A, DaisyMap.find e typeMap with
| Some (intv, err), Some m =>
if (Qleb 0 err) (* encoding soundness: errors are positive *)
then
match e with (* case analysis for the expression *)
......@@ -34,60 +32,74 @@ Fixpoint validErrorbound (e:exp Q) (* analyzed expression *)
Qleb (maxAbs intv * (mTypeToQ m)) err
|Unop Neg e1 =>
if (validErrorbound e1 typeMap A dVars)
then Qeq_bool err (snd (A e1))
then
match DaisyMap.find e1 A with
| Some (iv_e1, err1) => Qeq_bool err err1
| None => false
end
else false
|Unop Inv e1 => false
|Binop b e1 e2 =>
if ((validErrorbound e1 typeMap A dVars)
&& (validErrorbound e2 typeMap A dVars))
then
let (ive1, err1) := A e1 in
let (ive2, err2) := A e2 in
let errIve1 := widenIntv ive1 err1 in
let errIve2 := widenIntv ive2 err2 in
let upperBoundE1 := maxAbs ive1 in
let upperBoundE2 := maxAbs ive2 in
match b with
| Plus =>
Qleb (err1 + err2 + (maxAbs (addIntv errIve1 errIve2)) * (mTypeToQ m)) err
| Sub =>
Qleb (err1 + err2 + (maxAbs (subtractIntv errIve1 errIve2)) * (mTypeToQ m)) err
| Mult =>
Qleb ((upperBoundE1 * err2 + upperBoundE2 * err1 + err1 * err2) + (maxAbs (multIntv errIve1 errIve2)) * (mTypeToQ m)) err
| Div =>
if (((Qleb (ivhi errIve2) 0) && (negb (Qeq_bool (ivhi errIve2) 0))) ||
((Qleb 0 (ivlo errIve2)) && (negb (Qeq_bool (ivlo errIve2) 0))))
then
let upperBoundInvE2 := maxAbs (invertIntv ive2) in
let minAbsIve2 := minAbs (errIve2) in
let errInv := (1 / (minAbsIve2 * minAbsIve2)) * err2 in
Qleb ((upperBoundE1 * errInv + upperBoundInvE2 * err1 + err1 * errInv) + (maxAbs (divideIntv errIve1 errIve2)) * (mTypeToQ m)) err
else false
match DaisyMap.find e1 A, DaisyMap.find e2 A with
| Some (ive1, err1), Some (ive2, err2) =>
let errIve1 := widenIntv ive1 err1 in
let errIve2 := widenIntv ive2 err2 in
let upperBoundE1 := maxAbs ive1 in
let upperBoundE2 := maxAbs ive2 in
match b with
| Plus =>
Qleb (err1 + err2 + (maxAbs (addIntv errIve1 errIve2)) * (mTypeToQ m)) err
| Sub =>
Qleb (err1 + err2 + (maxAbs (subtractIntv errIve1 errIve2)) * (mTypeToQ m)) err
| Mult =>
Qleb ((upperBoundE1 * err2 + upperBoundE2 * err1 + err1 * err2) + (maxAbs (multIntv errIve1 errIve2)) * (mTypeToQ m)) err
| Div =>
if (((Qleb (ivhi errIve2) 0) && (negb (Qeq_bool (ivhi errIve2) 0))) ||
((Qleb 0 (ivlo errIve2)) && (negb (Qeq_bool (ivlo errIve2) 0))))
then
let upperBoundInvE2 := maxAbs (invertIntv ive2) in
let minAbsIve2 := minAbs (errIve2) in
let errInv := (1 / (minAbsIve2 * minAbsIve2)) * err2 in
Qleb ((upperBoundE1 * errInv + upperBoundInvE2 * err1 + err1 * errInv) + (maxAbs (divideIntv errIve1 errIve2)) * (mTypeToQ m)) err
else false
end
| _, _ => false
end
else false
|Downcast m1 e1 =>
if validErrorbound e1 typeMap A dVars
then
let (ive1, err1) := A e1 in
let errIve1 := widenIntv ive1 err1 in
(Qleb (err1 + maxAbs errIve1 * (mTypeToQ m1)) err)
match DaisyMap.find e1 A with
| Some (ive1, err1) =>
let errIve1 := widenIntv ive1 err1 in
(Qleb (err1 + maxAbs errIve1 * (mTypeToQ m1)) err)
| None => false
end
else
false
end
else false
| _, _ => false
end.
(** Error bound command validator **)
Fixpoint validErrorboundCmd (f:cmd Q) (* analyzed cmd with let's *)
(typeMap:exp Q -> option mType) (* inferred types *)
typeMap (* inferred types *)
(A:analysisResult) (* Daisy's encoded result *)
(dVars:NatSet.t) (* defined variables *)
: bool :=
match f with
|Let m x e g =>
if ((validErrorbound e typeMap A dVars) && (Qeq_bool (snd (A e)) (snd (A (Var Q x)))))
then validErrorboundCmd g typeMap A (NatSet.add x dVars)
else false
match DaisyMap.find e A, DaisyMap.find (Var Q x) A with
| Some (iv_e, err_e), Some (iv_x, err_x) =>
if ((validErrorbound e typeMap A dVars) && (Qeq_bool err_e err_x))
then validErrorboundCmd g typeMap A (NatSet.add x dVars)
else false
| _,_ => false
end
|Ret e => validErrorbound e typeMap A dVars
end.
......
......@@ -91,6 +91,15 @@ Ltac match_simpl :=
repeat match_factorize;
try pair_factorize.
Ltac bool_factorize :=
match goal with
| [H: _ = true |- _] => andb_to_prop H
end.
Ltac Daisy_compute :=
repeat
(match_simpl || bool_factorize).
(* Ltac destruct_if := *)
(* match goal with *)
(* | [H: if ?c then ?a else ?b = _ |- _ ] => *)
......
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