Merge branch 'errors_affine' into 'master'

Rework type for delta map and fix issue #13

Closes #13

See merge request AVA/FloVer!18

coq/CertificateChecker.v

@@ -30,8 +30,8 @@ Definition CertificateChecker (e:expr Q) (absenv:analysisResult)
 **)
 Theorem Certificate_checking_is_sound (e:expr Q) (absenv:analysisResult) P defVars:
   forall (E1 E2:env) DeltaMap,
-    (forall (e' : expr R) (m' : mType),
-        exists d : R, DeltaMap e' m' = Some d /\ (Rabs d <= mTypeToR m')%R) ->
+    (forall (v : R) (m' : mType),
+        exists d : R, DeltaMap v m' = Some d /\ (Rabs d <= mTypeToR m')%R) ->
     (forall v, NatSet.In v (Expressions.usedVars e) ->
           exists vR, E1 v = Some vR /\
                 (Q2R (fst (P v)) <= vR <= Q2R (snd (P v)))%R) ->
@@ -81,10 +81,10 @@ Proof.
   exists Gamma; intros approxE1E2.
   assert (dVars_contained NatSet.empty (FloverMap.empty (affine_form Q))) as Hdvars
          by (unfold dVars_contained; intros * Hset; clear - Hset; set_tac).
-  pose proof (RoundoffErrorValidator_sound e _ deltas_matched H approxE1E2 H1 eval_real R
+  pose proof (RoundoffErrorValidator_sound e H approxE1E2 H1 eval_real R
                                           valid_e map_e Hdvars) as Hsound.
   unfold validErrorBounds in Hsound.
-  eapply validErrorBounds_single in Hsound; eauto.
+  eapply validErrorBoundsRec_single in Hsound; eauto.
   destruct Hsound as [[vF [mF eval_float]] err_bounded]; auto.
   exists (elo, ehi), err_e, vR, vF, mF; repeat split; auto.
 Qed.
@@ -106,8 +106,8 @@ Definition CertificateCheckerCmd (f:cmd Q) (absenv:analysisResult) (P:precond)
 Theorem Certificate_checking_cmds_is_sound (f:cmd Q) (absenv:analysisResult) P
         defVars DeltaMap:
   forall (E1 E2:env),
-    (forall (e' : expr R) (m' : mType),
-        exists d : R, DeltaMap e' m' = Some d /\ (Rabs d <= mTypeToR m')%R) ->
+    (forall (v : R) (m' : mType),
+        exists d : R, DeltaMap v  m' = Some d /\ (Rabs d <= mTypeToR m')%R) ->
     (forall v, NatSet.In v (freeVars f) ->
           exists vR, E1 v = Some vR /\
                 (Q2R (fst (P v)) <= vR <= Q2R (snd (P v)))%R) ->
@@ -158,7 +158,7 @@ Proof.
   destruct valid_single as [iv [ err [vR [map_f [eval_real bounded_real_f]]]]].
   destruct iv as [f_lo f_hi].
   pose proof RoundoffErrorValidatorCmd_sound as Hsound.
-  eapply validErrorBoundsCmd_single in Hsound; eauto.
+  eapply validErrorBoundsCmdRec_single in Hsound; eauto.
   2: unfold dVars_contained; intros; set_tac.
   specialize Hsound as ((vF & mF & eval_float) & ?).
   exists (f_lo, f_hi), err, vR, vF, mF; repeat split; try auto.

coq/Commands.v

@@ -48,7 +48,7 @@ Inductive sstep : cmd R -> env -> R -> cmd R -> env -> Prop :=
   Define big step semantics for the Flover language, terminating on a "returned"
   result value
  **)
-Inductive bstep : cmd R -> env -> (expr R -> option mType) -> (expr R -> mType -> option R) ->
+Inductive bstep : cmd R -> env -> (expr R -> option mType) -> (R -> mType -> option R) ->
                   R -> mType -> Prop :=
   let_b m m' x e s E v res defVars DeltaMap:
     eval_expr E defVars DeltaMap e v m ->

coq/ErrorAnalysis.v

@@ -4,17 +4,17 @@ From Coq
 From Flover
      Require Import Commands ExpressionSemantics Environments RealRangeArith TypeValidator.
 
-Fixpoint validErrorBounds (e:expr Q) E1 E2 A Gamma DeltaMap :Prop :=
+Fixpoint validErrorBoundsRec (e:expr Q) E1 E2 A Gamma DeltaMap :Prop :=
   (match e with
-  | Unop u e => validErrorBounds e E1 E2 A Gamma DeltaMap
-  | Downcast m e => validErrorBounds e E1 E2 A Gamma DeltaMap
+  | Unop u e => validErrorBoundsRec e E1 E2 A Gamma DeltaMap
+  | Downcast m e => validErrorBoundsRec e E1 E2 A Gamma DeltaMap
   | Binop b e1 e2 =>
-    validErrorBounds e1 E1 E2 A Gamma DeltaMap /\
-    validErrorBounds e2 E1 E2 A Gamma DeltaMap
+    validErrorBoundsRec e1 E1 E2 A Gamma DeltaMap /\
+    validErrorBoundsRec e2 E1 E2 A Gamma DeltaMap
   | Fma e1 e2 e3 =>
-    validErrorBounds e1 E1 E2 A Gamma DeltaMap /\
-    validErrorBounds e2 E1 E2 A Gamma DeltaMap /\
-    validErrorBounds e3 E1 E2 A Gamma DeltaMap
+    validErrorBoundsRec e1 E1 E2 A Gamma DeltaMap /\
+    validErrorBoundsRec e2 E1 E2 A Gamma DeltaMap /\
+    validErrorBoundsRec e3 E1 E2 A Gamma DeltaMap
   | _ => True
    end)  /\
   forall v__R (iv: intv) (err: error),
@@ -26,8 +26,14 @@ Fixpoint validErrorBounds (e:expr Q) E1 E2 A Gamma DeltaMap :Prop :=
         eval_expr E2 (toRExpMap Gamma) DeltaMap (toRExp e) v__FP m__FP ->
         (Rabs (v__R - v__FP) <= (Q2R err))%R).
 
-Lemma validErrorBounds_single e E1 E2 A Gamma DeltaMap:
-  validErrorBounds e E1 E2 A Gamma DeltaMap ->
+Definition validErrorBounds e E1 E2 A Gamma: Prop :=
+  forall DeltaMap,
+    (forall (v : R) (m' : mType),
+        exists d : R, DeltaMap v m' = Some d /\ (Rabs d <= mTypeToR m')%R) ->
+    validErrorBoundsRec e E1 E2 A Gamma DeltaMap.
+
+Lemma validErrorBoundsRec_single e E1 E2 A Gamma DeltaMap:
+  validErrorBoundsRec e E1 E2 A Gamma DeltaMap ->
   forall v__R iv err,
     eval_expr E1 (toRTMap (toRExpMap Gamma)) DeltaMapR (toREval (toRExp e)) v__R REAL ->
     FloverMap.find e A = Some (iv, err) ->
@@ -39,13 +45,13 @@ Lemma validErrorBounds_single e E1 E2 A Gamma DeltaMap:
 Proof.
   intros validError_e;
     intros;  destruct e; cbn in *; split;
-      destruct validError_e as (? & ? & ?); eauto.
+      edestruct validError_e as (? & ? & ?); eauto.
 Qed.
 
-Fixpoint validErrorBoundsCmd (c: cmd Q) E1 E2 A Gamma DeltaMap: Prop :=
+Fixpoint validErrorBoundsCmdRec (c: cmd Q) E1 E2 A Gamma DeltaMap: Prop :=
   match c with
   | Let m x e k =>
-    validErrorBounds e E1 E2 A Gamma DeltaMap /\
+    validErrorBoundsRec e E1 E2 A Gamma DeltaMap /\
     (exists iv_e err_e iv_x err_x,
        FloverMap.find e A = Some (iv_e, err_e) /\
        FloverMap.find (Var Q x) A = Some (iv_x, err_x) /\
@@ -53,8 +59,8 @@ Fixpoint validErrorBoundsCmd (c: cmd Q) E1 E2 A Gamma DeltaMap: Prop :=
     (forall v__R v__FP,
         eval_expr E1 (toRTMap (toRExpMap Gamma)) DeltaMapR (toREval (toRExp e)) v__R REAL ->
         eval_expr E2 (toRExpMap Gamma) DeltaMap (toRExp e) v__FP m ->
-        validErrorBoundsCmd k (updEnv x v__R E1) (updEnv x v__FP E2) A Gamma DeltaMap)
-  | Ret e => validErrorBounds e E1 E2 A Gamma DeltaMap
+        validErrorBoundsCmdRec k (updEnv x v__R E1) (updEnv x v__FP E2) A Gamma DeltaMap)
+  | Ret e => validErrorBoundsRec e E1 E2 A Gamma DeltaMap
   end  /\
   forall v__R (iv: intv) (err: error),
     bstep (toREvalCmd (toRCmd c)) E1 (toRTMap (toRExpMap Gamma)) DeltaMapR v__R REAL ->
@@ -65,8 +71,14 @@ Fixpoint validErrorBoundsCmd (c: cmd Q) E1 E2 A Gamma DeltaMap: Prop :=
         bstep (toRCmd c) E2 (toRExpMap Gamma) DeltaMap v__FP m__FP ->
         (Rabs (v__R - v__FP) <= (Q2R err))%R).
 
-Lemma validErrorBoundsCmd_single c E1 E2 A Gamma DeltaMap:
-  validErrorBoundsCmd c E1 E2 A Gamma DeltaMap ->
+Definition validErrorBoundsCmd (c: cmd Q) E1 E2 A Gamma: Prop :=
+  forall DeltaMap,
+    (forall (v : R) (m' : mType),
+        exists d : R, DeltaMap v m' = Some d /\ (Rabs d <= mTypeToR m')%R) ->
+    validErrorBoundsCmdRec c E1 E2 A Gamma DeltaMap.
+
+Lemma validErrorBoundsCmdRec_single c E1 E2 A Gamma DeltaMap:
+  validErrorBoundsCmdRec c E1 E2 A Gamma DeltaMap ->
   forall v__R (iv: intv) (err: error),
     bstep (toREvalCmd (toRCmd c)) E1 (toRTMap (toRExpMap Gamma)) DeltaMapR v__R REAL ->
     FloverMap.find (getRetExp c) A = Some (iv, err) ->
@@ -78,5 +90,5 @@ Lemma validErrorBoundsCmd_single c E1 E2 A Gamma DeltaMap:
 Proof.
   intros validError_e;
     intros;  destruct c; cbn in *; split;
-      destruct validError_e as (? & ? & ?); eauto.
+      edestruct validError_e as (? & ? & ?); eauto.
 Qed.

coq/ErrorBounds.v

@@ -43,8 +43,8 @@ Lemma add_abs_err_bounded (e1:expr Q) (e1R:R) (e1F:R) (e2:expr Q) (e2R:R) (e2F:R
   eval_expr (updEnv 2 e2F (updEnv 1 e1F emptyEnv))
             (updDefVars (Binop Plus (Var R 1) (Var R 2)) m
                         (updDefVars (Var R 2) m2 (updDefVars (Var R 1) m1 defVars)))
-            (fun x _ => if R_orderedExps.eq_dec x (Binop Plus (Var R 1) (Var R 2))
-                     then DeltaMap (Binop Plus (toRExp e1) (toRExp e2)) m
+            (fun x _ => if Req_dec_sum x (evalBinop Plus e1F e2F)
+                     then DeltaMap (evalBinop Plus e1F e2F) m
                      else None)
             (Binop Plus (Var R 1) (Var R 2)) vF m ->
   (Rabs (e1R - e1F) <= Q2R err1)%R ->
@@ -116,8 +116,8 @@ Lemma subtract_abs_err_bounded (e1:expr Q) (e1R:R) (e1F:R) (e2:expr Q) (e2R:R)
   eval_expr (updEnv 2 e2F (updEnv 1 e1F emptyEnv))
             (updDefVars (Binop Sub (Var R 1) (Var R 2)) m
                         (updDefVars (Var R 2) m2 (updDefVars (Var R 1) m1 defVars)))
-            (fun x _ => if R_orderedExps.eq_dec x (Binop Sub (Var R 1) (Var R 2))
-                     then DeltaMap (Binop Sub (toRExp e1) (toRExp e2)) m
+            (fun x _ => if Req_dec_sum x (evalBinop Sub e1F e2F)
+                     then DeltaMap (evalBinop Sub e1F e2F) m
                      else None)
             (Binop Sub (Var R 1) (Var R 2)) vF m ->
   (Rabs (e1R - e1F) <= Q2R err1)%R ->
@@ -194,8 +194,8 @@ Lemma mult_abs_err_bounded (e1:expr Q) (e1R:R) (e1F:R) (e2:expr Q) (e2R:R) (e2F:
   eval_expr (updEnv 2 e2F (updEnv 1 e1F emptyEnv))
             (updDefVars (Binop Mult (Var R 1) (Var R 2)) m
                         (updDefVars (Var R 2) m2 (updDefVars (Var R 1) m1 defVars)))
-            (fun x _ => if R_orderedExps.eq_dec x (Binop Mult (Var R 1) (Var R 2))
-                     then DeltaMap (Binop Mult (toRExp e1) (toRExp e2)) m
+            (fun x _ => if Req_dec_sum x (evalBinop Mult e1F e2F)
+                     then DeltaMap (evalBinop Mult e1F e2F) m
                      else None)
             (Binop Mult (Var R 1) (Var R 2)) vF m ->
   (Rabs (vR - vF) <= Rabs (e1R * e2R - e1F * e2F) + computeErrorR (e1F * e2F) m)%R.
@@ -245,8 +245,8 @@ Lemma div_abs_err_bounded (e1:expr Q) (e1R:R) (e1F:R) (e2:expr Q) (e2R:R) (e2F:R
   eval_expr (updEnv 2 e2F (updEnv 1 e1F emptyEnv))
             (updDefVars (Binop Div (Var R 1) (Var R 2)) m
                         (updDefVars (Var R 2) m2 (updDefVars (Var R 1) m1 defVars)))
-            (fun x _ => if R_orderedExps.eq_dec x (Binop Div (Var R 1) (Var R 2))
-                     then DeltaMap (Binop Div (toRExp e1) (toRExp e2)) m
+            (fun x _ => if Req_dec_sum x (evalBinop Div e1F e2F)
+                     then DeltaMap (evalBinop Div e1F e2F) m
                      else None)
             (Binop Div (Var R 1) (Var R 2)) vF m ->
   (Rabs (vR - vF) <= Rabs (e1R / e2R - e1F / e2F) + computeErrorR (e1F / e2F) m)%R.
@@ -301,8 +301,8 @@ Lemma fma_abs_err_bounded (e1:expr Q) (e1R:R) (e1F:R) (e2:expr Q) (e2R:R) (e2F:R
             (updDefVars (Fma (Var R 1) (Var R 2) (Var R 3)) m
                         (updDefVars (Var R 3) m3
                                     (updDefVars (Var R 2) m2 (updDefVars (Var R 1) m1 defVars))))
-            (fun x _ => if R_orderedExps.eq_dec x (Fma (Var R 1) (Var R 2) (Var R 3))
-                     then DeltaMap (Fma (toRExp e1) (toRExp e2) (toRExp e3)) m
+            (fun x _ => if Req_dec_sum x (evalFma e1F e2F e3F)
+                     then DeltaMap (evalFma e1F e2F e3F) m
                      else None)
             (Fma (Var R 1) (Var R 2) (Var R 3)) vF m ->
   (Rabs (vR - vF) <= Rabs ((e1R - e1F) + (e2R * e3R - e2F * e3F)) + computeErrorR (e1F + e2F * e3F ) m)%R.
@@ -366,8 +366,8 @@ Lemma round_abs_err_bounded (e:expr R) (nR nF1 nF:R) (E1 E2: env) (err:R)
   eval_expr (updEnv 1 nF1 emptyEnv)
             (updDefVars (Downcast mEps (Var R 1)) mEps
                         (updDefVars (Var R 1) m defVars))
-            (fun x _ => if R_orderedExps.eq_dec x (Downcast mEps (Var R 1))
-                     then DeltaMap (Downcast mEps e) mEps
+            (fun x _ => if Req_dec_sum x nF1
+                     then DeltaMap nF1 mEps
                      else None)
             (toRExp (Downcast mEps (Var Q 1))) nF mEps->
   (Rabs (nR - nF1) <= err)%R ->

coq/ExpressionSemantics.v

@@ -34,16 +34,16 @@ Open Scope R_scope.
 
 Inductive eval_expr (E:env)
           (Gamma: expr R -> option mType)
-          (DeltaMap: expr R -> mType -> option R)
+          (DeltaMap: R -> mType -> option R)
   :(expr R) -> R -> mType -> Prop :=
 | Var_load m x v:
     Gamma (Var R x) = Some m ->
     E x = Some v ->
     eval_expr E Gamma DeltaMap (Var R x) v m
-| Const_dist m n delta:
-    DeltaMap (Const m n) m = Some delta ->
+| Const_dist m c delta:
+    DeltaMap c m = Some delta ->
     Rabs delta <= mTypeToR m ->
-    eval_expr E Gamma DeltaMap (Const m n) (perturb n m delta) m
+    eval_expr E Gamma DeltaMap (Const m c) (perturb c m delta) m
 | Unop_neg m mN f1 v1:
     Gamma (Unop Neg f1) = Some mN ->
     isCompat m mN = true ->
@@ -51,7 +51,7 @@ Inductive eval_expr (E:env)
     eval_expr E Gamma DeltaMap (Unop Neg f1) (evalUnop Neg v1) mN
 | Unop_inv m mN f1 v1 delta:
     Gamma (Unop Inv f1) = Some mN ->
-    DeltaMap (Unop Inv f1) mN = Some delta ->
+    DeltaMap (evalUnop Inv v1) mN = Some delta ->
     isCompat m mN = true ->
     Rabs delta <= mTypeToR mN ->
     eval_expr E Gamma DeltaMap f1 v1 m ->
@@ -59,14 +59,14 @@ Inductive eval_expr (E:env)
     eval_expr E Gamma DeltaMap (Unop Inv f1) (perturb (evalUnop Inv v1) mN delta) mN
 | Downcast_dist m m1 f1 v1 delta:
     Gamma (Downcast m f1) = Some m ->
-    DeltaMap (Downcast m f1) m = Some delta ->
+    DeltaMap v1 m = Some delta ->
     isMorePrecise m1 m = true ->
     Rabs delta <= mTypeToR m ->
     eval_expr E Gamma DeltaMap f1 v1 m1 ->
     eval_expr E Gamma DeltaMap (Downcast m f1) (perturb v1 m delta) m
 | Binop_dist m1 m2 op f1 f2 v1 v2 delta m:
     Gamma (Binop op f1 f2) = Some m ->
-    DeltaMap (Binop op f1 f2) m = Some delta ->
+    DeltaMap (evalBinop op v1 v2) m = Some delta ->
     isJoin m1 m2 m = true ->
     Rabs delta <= mTypeToR m ->
     eval_expr E Gamma DeltaMap f1 v1 m1 ->
@@ -75,7 +75,7 @@ Inductive eval_expr (E:env)
     eval_expr E Gamma DeltaMap (Binop op f1 f2) (perturb (evalBinop op v1 v2) m delta) m
 | Fma_dist m1 m2 m3 m f1 f2 f3 v1 v2 v3 delta:
     Gamma (Fma f1 f2 f3) = Some m ->
-    DeltaMap (Fma f1 f2 f3) m = Some delta ->
+    DeltaMap (evalFma v1 v2 v3) m = Some delta ->
     isJoin3 m1 m2 m3 m = true ->
     Rabs delta <= mTypeToR m ->
     eval_expr E Gamma DeltaMap f1 v1 m1 ->
@@ -83,7 +83,7 @@ Inductive eval_expr (E:env)
     eval_expr E Gamma DeltaMap f3 v3 m3 ->
     eval_expr E Gamma DeltaMap (Fma f1 f2 f3) (perturb (evalFma v1 v2 v3) m delta) m.
 
-Definition DeltaMapR: expr R -> mType -> option R := (fun x m => Some 0).
+Definition DeltaMapR: R -> mType -> option R := (fun x m => Some 0).
 
 Close Scope R_scope.
 
@@ -92,12 +92,12 @@ Hint Constructors eval_expr.
 (** *)
 (*   Show some simpler (more general) rule lemmata *)
 (* **)
-Lemma Const_dist' DeltaMap m n delta v m' E Gamma:
+Lemma Const_dist' DeltaMap m c delta v m' E Gamma:
   Rle (Rabs delta) (mTypeToR m') ->
-  DeltaMap (Const m n) m = Some delta ->
-  v = perturb n m delta ->
+  DeltaMap c m = Some delta ->
+  v = perturb c m delta ->
   m' = m ->
-  eval_expr E Gamma DeltaMap (Const m n) v m'.
+  eval_expr E Gamma DeltaMap (Const m c) v m'.
 Proof.
   intros; subst; auto.
 Qed.
@@ -120,7 +120,7 @@ Hint Resolve Unop_neg'.
 Lemma Unop_inv' DeltaMap m mN f1 v1 delta v m' E Gamma:
   Rle (Rabs delta) (mTypeToR m') ->
   eval_expr E Gamma DeltaMap f1 v1 m ->
-  DeltaMap (Unop Inv f1) m' = Some delta ->
+  DeltaMap (evalUnop Inv v1) m' = Some delta ->
   (~ v1 = 0)%R  ->
   v = perturb (evalUnop Inv v1) mN delta ->
   Gamma (Unop Inv f1) = Some mN ->
@@ -137,7 +137,7 @@ Lemma Downcast_dist' DeltaMap m m1 f1 v1 delta v m' E Gamma:
   isMorePrecise m1 m = true ->
   Rle (Rabs delta) (mTypeToR m') ->
   eval_expr E Gamma DeltaMap f1 v1 m1 ->
-  DeltaMap (Downcast m f1) m' = Some delta ->
+  DeltaMap v1 m' = Some delta ->
   v = (perturb v1 m delta) ->
   Gamma (Downcast m f1) = Some m ->
   m' = m ->
@@ -152,7 +152,7 @@ Lemma Binop_dist' DeltaMap m1 m2 op f1 f2 v1 v2 delta v m m' E Gamma:
   Rle (Rabs delta) (mTypeToR m') ->
   eval_expr E Gamma DeltaMap f1 v1 m1 ->
   eval_expr E Gamma DeltaMap f2 v2 m2 ->
-  DeltaMap (Binop op f1 f2) m' = Some delta ->
+  DeltaMap (evalBinop op v1 v2) m' = Some delta ->
   ((op = Div) -> (~ v2 = 0)%R) ->
   v = perturb (evalBinop op v1 v2) m' delta ->
   Gamma (Binop op f1 f2) = Some m ->
@@ -170,7 +170,7 @@ Lemma Fma_dist' DeltaMap m1 m2 m3 f1 f2 f3 v1 v2 v3 delta v m' E Gamma m:
   eval_expr E Gamma DeltaMap f1 v1 m1 ->
   eval_expr E Gamma DeltaMap f2 v2 m2 ->
   eval_expr E Gamma DeltaMap f3 v3 m3 ->
-  DeltaMap (Fma f1 f2 f3) m' = Some delta ->
+  DeltaMap (evalFma v1 v2 v3) m' = Some delta ->
   v = perturb (evalFma v1 v2 v3) m' delta ->
   Gamma (Fma f1 f2 f3) = Some m ->
   isJoin3 m1 m2 m3 m = true ->
@@ -293,15 +293,15 @@ variables in the Environment.
 Lemma binary_unfolding b f1 f2 E v1 v2 m1 m2 m Gamma DeltaMap delta:
   (b = Div -> ~(v2 = 0 )%R) ->
   (Rabs delta <= mTypeToR m)%R ->
-  DeltaMap (Binop b f1 f2) m = Some delta ->
+  DeltaMap (evalBinop b v1 v2) m = Some delta ->
   eval_expr E Gamma DeltaMap f1 v1 m1 ->
   eval_expr E Gamma DeltaMap f2 v2 m2 ->
   eval_expr E Gamma DeltaMap (Binop b f1 f2) (perturb (evalBinop b v1 v2) m delta) m ->
   eval_expr (updEnv 2 v2 (updEnv 1 v1 emptyEnv))
             (updDefVars (Binop b (Var R 1) (Var R 2)) m
                         (updDefVars (Var R 2) m2 (updDefVars (Var R 1) m1 Gamma)))
-            (fun x _ => if R_orderedExps.eq_dec x (Binop b (Var R 1) (Var R 2))
-                     then DeltaMap (Binop b f1 f2) m
+            (fun x _ => if Req_dec_sum x (evalBinop b v1 v2)
+                     then DeltaMap (evalBinop b v1 v2) m
                      else None)
             (Binop b (Var R 1) (Var R 2)) (perturb (evalBinop b v1 v2) m delta) m.
 Proof.
@@ -319,15 +319,15 @@ Proof.
   eapply Binop_dist' with (v1:=v1) (v2:=v2) (delta:=delta); try eauto.
   - eapply Var_load; eauto.
   - eapply Var_load; eauto.
-  - destruct R_orderedExps.eq_dec as [?|H]; auto.
-    exfalso; apply H; apply R_orderedExps.eq_refl.
+  - destruct Req_dec_sum as [?|H]; auto.
+    exfalso; now apply H.
   - unfold updDefVars.
     unfold R_orderedExps.compare; rewrite R_orderedExps.exprCompare_refl; auto.
 Qed.
 
 Lemma fma_unfolding f1 f2 f3 E v1 v2 v3 m1 m2 m3 m Gamma DeltaMap delta:
   (Rabs delta <= mTypeToR m)%R ->
-  DeltaMap (Fma f1 f2 f3) m = Some delta ->
+  DeltaMap (evalFma v1 v2 v3) m = Some delta ->
   eval_expr E Gamma DeltaMap f1 v1 m1 ->
   eval_expr E Gamma DeltaMap f2 v2 m2 ->
   eval_expr E Gamma DeltaMap f3 v3 m3 ->
@@ -336,8 +336,8 @@ Lemma fma_unfolding f1 f2 f3 E v1 v2 v3 m1 m2 m3 m Gamma DeltaMap delta:
             (updDefVars (Fma (Var R 1) (Var R 2) (Var R 3) ) m
                         (updDefVars (Var R 3) m3 (updDefVars (Var R 2) m2
                                                              (updDefVars (Var R 1) m1 Gamma))))
-            (fun x _ => if R_orderedExps.eq_dec x (Fma (Var R 1) (Var R 2) (Var R 3))
-                     then DeltaMap (Fma f1 f2 f3) m
+            (fun x _ => if Req_dec_sum x (evalFma v1 v2 v3)
+                     then DeltaMap (evalFma v1 v2 v3) m
                      else None)
             (Fma (Var R 1) (Var R 2) (Var R 3)) (perturb (evalFma v1 v2 v3) m delta) m.
 Proof.
@@ -357,7 +357,9 @@ Proof.
   - eapply Var_load; eauto.
   - eapply Var_load; eauto.
   - eapply Var_load; eauto.
-  - cbn; auto.
+  - destruct Req_dec_sum as [? | Hneq]; auto.
+    contradiction Hneq; auto.
+  - now cbn.
 Qed.
 
 Lemma eval_eq_env e:
@@ -476,21 +478,29 @@ Proof.
   - destruct u; inversion Heval1; inversion Heval2; subst.
     + f_equal; eapply IHe; eauto.
       erewrite Gamma_det; eauto.
-    + replace delta with delta0 by congruence.
-      f_equal; f_equal; eapply IHe; eauto.
-      erewrite Gamma_det; eauto.
+    + replace m0 with m in * by (eapply Gamma_det; eauto).
+      replace v3 with v0 in * by (eapply IHe; eauto).
+      replace delta with delta0 by congruence.
+      reflexivity.
   - inversion Heval1; inversion Heval2; subst.
-    replace delta with delta0 by congruence.
-    f_equal; f_equal; [eapply IHe1 | eapply IHe2]; eauto;
-      erewrite Gamma_det; eauto.
+    replace m1 with m0 in * by (eapply Gamma_det; eauto).
+    replace m3 with m2 in * by (eapply Gamma_det; eauto).
+    replace v4 with v0 in * by (eapply IHe1; eauto).
+    replace v5 with v3 in * by (eapply IHe2; eauto).
+    now replace delta with delta0 by congruence.
   - inversion Heval1; inversion Heval2; subst.
-    replace delta with delta0 by congruence.
-    f_equal; f_equal; [eapply IHe1 | eapply IHe2 | eapply IHe3]; eauto;
-      erewrite Gamma_det; eauto.
+    replace m1 with m0 in * by (eapply Gamma_det; eauto).
+    replace m4 with m2 in * by (eapply Gamma_det; eauto).
+    replace m5 with m3 in * by (eapply Gamma_det; eauto).
+    replace v5 with v0 in * by (eapply IHe1; eauto).
+    replace v6 with v3 in * by (eapply IHe2; eauto).
+    replace v7 with v4 in * by (eapply IHe3; eauto).
+    now replace delta with delta0 by congruence.
   - inversion Heval1; inversion Heval2; subst.
+    replace m3 with m1 in * by (eapply Gamma_det; eauto).
+    replace v3 with v0 in * by (eapply IHe; eauto).
     replace delta with delta0 by congruence.
-    f_equal; f_equal; eapply IHe; eauto;
-      erewrite Gamma_det; eauto.
+    reflexivity.
 Qed.
 
 Lemma real_eval_expr_ignores_delta_map (f:expr R) (E:env) Gamma:

coq/FPRangeValidator.v

@@ -71,13 +71,13 @@ Ltac prove_fprangeval m v L1 R:=
 
 Theorem FPRangeValidator_sound:
   forall (e:expr Q) E1 E2 Gamma DeltaMap v m A fVars dVars,
-  (forall (e' : expr R) (m' : mType),
-      exists d : R, DeltaMap e' m' = Some d /\ (Rabs d <= mTypeToR m')%R) ->
+  (forall (v : R) (m' : mType),
+      exists d : R, DeltaMap v m' = Some d /\ (Rabs d <= mTypeToR m')%R) ->
   approxEnv E1 (toRExpMap Gamma) A fVars dVars E2 ->
   eval_expr E2 (toRExpMap Gamma) DeltaMap (toRExp e) v m ->
   validTypes e Gamma ->
   validRanges e A E1 (toRTMap (toRExpMap Gamma)) ->
-  validErrorBounds e E1 E2 A Gamma DeltaMap ->
+  validErrorBoundsRec e E1 E2 A Gamma DeltaMap ->
   FPRangeValidator e A Gamma dVars = true ->
   NatSet.Subset (NatSet.diff (usedVars e) dVars) fVars ->
   (forall v, NatSet.In v dVars ->
@@ -98,7 +98,7 @@ Proof.
   destruct valid_e as [iv_e [err_e [vR[ map_e[eval_real vR_bounded]]]]].
   destruct iv_e as  [e_lo e_hi].
   assert (Rabs (vR - v) <= Q2R (err_e))%R.
-  { eapply validErrorBounds_single; eauto. }
+  { eapply validErrorBoundsRec_single; eauto. }
   destruct (distance_gives_iv (a:=vR) v (e:=Q2R err_e) (Q2R e_lo, Q2R e_hi))
     as [v_in_errIv];
     try auto.
@@ -146,15 +146,15 @@ Qed.
 
 Lemma FPRangeValidatorCmd_sound (f:cmd Q):
   forall E1 E2 Gamma DeltaMap v vR m A fVars dVars outVars,
-  (forall (e' : expr R) (m' : mType),
-      exists d : R, DeltaMap e' m' = Some d /\ (Rabs d <= mTypeToR m')%R) ->
+  (forall (v : R) (m' : mType),
+      exists d : R, DeltaMap v m' = Some d /\ (Rabs d <= mTypeToR m')%R) ->
   approxEnv E1 (toRExpMap Gamma) A fVars dVars E2 ->
   ssa f (NatSet.union fVars dVars) outVars ->
   bstep (toREvalCmd (toRCmd f)) E1 (toRTMap (toRExpMap Gamma)) DeltaMapR vR m ->
   bstep (toRCmd f) E2 (toRExpMap Gamma) DeltaMap v m ->
   validTypesCmd f Gamma ->
   validRangesCmd f A E1 (toRTMap (toRExpMap Gamma)) ->
-  validErrorBoundsCmd f E1 E2 A Gamma DeltaMap ->
+  validErrorBoundsCmdRec f E1 E2 A Gamma DeltaMap ->
   FPRangeValidatorCmd f A Gamma dVars = true ->
   NatSet.Subset (NatSet.diff (freeVars f) dVars) fVars ->
   (forall v, NatSet.In v dVars ->
@@ -177,37 +177,27 @@ Proof.
     pose proof (validRanges_single _ _ _ _ valid_e) as valid_e_single.
     destruct valid_e_single
       as [iv_e [err_e [vR_e [map_e [eval_e_real bounded_vR_e]]]]].
-    destruct H6 as ((validerr_e & validerr_rec) & validerr_single).
-    pose proof (validErrorBounds_single _ _ _ _ validerr_e) as validerr_e_single.
+    destruct H6 as ((validerr_e & validerr_rec) & validerr_single); auto.
+    pose proof (validErrorBoundsRec_single _ _ _ _ validerr_e) as validerr_e_single.
     specialize (validerr_e_single v0 iv_e err_e H19 map_e) as
         ((vF_e & m_e & eval_float_e) & err_bounded_e).
-    (* destr_factorize.
-    edestruct (validErrorbound_sound (e:=e) (E1:=E1) (E2:=E2) (fVars:=fVars)
-                                     (dVars := dVars) (A:=A)
-                                     (nR:=v0) (err:=err_e) (elo:=fst iv_e) (ehi:=snd iv_e))
-      as [[vF_e [m_e eval_float_e]] err_bounded_e]; eauto.
-    + set_tac. split; try auto.
-      split; try auto.
-      hnf; intros; subst; set_tac.
-    + destruct iv_e; auto.
-    + *)
-      rewrite <- (meps_0_deterministic (toRExp e) eval_e_real H19) in *; try auto.
-      apply (IHf (updEnv n vR_e E1) (updEnv n v1 E2)
-                 Gamma DeltaMap v vR m0 A fVars
-                 (NatSet.add n dVars) (outVars)); eauto.
+    rewrite <- (meps_0_deterministic (toRExp e) eval_e_real H19) in *; try auto.
+    apply (IHf (updEnv n vR_e E1) (updEnv n v1 E2)
+               Gamma DeltaMap v vR m0 A fVars
+               (NatSet.add n dVars) (outVars)); eauto.
     * destruct validerr_rec as [[iv_e2 [err_e2 [iv_x [err_x [find_e [find_x eqfind]]]]]] validerr_rec].
       rewrite find_e in *; canonize_hyps. inversion map_e; subst.
       eapply approxUpdBound; eauto; simpl in *.
-        { eapply toRExpMap_some; eauto. simpl; auto. }
-        { rewrite <- eqfind. eapply err_bounded_e. eauto. }
-      * eapply ssa_equal_set; eauto.
-        hnf. intros a; split; intros in_set.
-        { rewrite NatSet.add_spec, NatSet.union_spec;
-            rewrite NatSet.union_spec, NatSet.add_spec in in_set.
-          destruct in_set as [P1 | [ P2 | P3]]; auto. }
-        { rewrite NatSet.add_spec, NatSet.union_spec in in_set;
-            rewrite NatSet.union_spec, NatSet.add_spec.
-          destruct in_set as [P1 | [ P2 | P3]]; auto. }
+      { eapply toRExpMap_some; eauto. simpl; auto. }
+      { rewrite <- eqfind. eapply err_bounded_e. eauto. }
+    * eapply ssa_equal_set; eauto.
+      hnf. intros a; split; intros in_set.
+      { rewrite NatSet.add_spec, NatSet.union_spec;
+          rewrite NatSet.union_spec, NatSet.add_spec in in_set.
+        destruct in_set as [P1 | [ P2 | P3]]; auto. }
+      { rewrite NatSet.add_spec, NatSet.union_spec in in_set;
+          rewrite NatSet.union_spec, NatSet.add_spec.
+        destruct in_set as [P1 | [ P2 | P3]]; auto. }
         (*
          * eapply (swap_Gamma_bstep (Gamma1 := updDefVars n REAL (toRMap Gamma))); eauto.
         eauto using Rmap_updVars_comm.
@@ -215,13 +205,13 @@ Proof.
             { intros x; unfold toRMap, updDefVars.
               destruct (x =? n) eqn:?; auto. }
             { eapply valid_rec. auto. } *)
-      * destruct validerr_rec; auto.
-      * set_tac; split.
-        { split; try auto.
-          hnf; intros; subst.
-          apply H6; rewrite NatSet.add_spec; auto. }
-        { hnf; intros.
-          apply H6; rewrite NatSet.add_spec; auto. }
+    * destruct validerr_rec; auto.
+    * set_tac; split.
+      { split; try auto.
+        hnf; intros; subst.
+        apply H6; rewrite NatSet.add_spec; auto. }
+      { hnf; intros.
+        apply H6; rewrite NatSet.add_spec; auto. }
         (*
       * unfold vars_typed. intros.
         unfold updDefVars.
@@ -231,17 +221,20 @@ Proof.
         rewrite NatSet.add_spec in H4.
         rewrite Nat.eqb_neq in *.
         destruct H4; subst; try congruence; auto. *)
-      * intros. unfold updEnv.
-        type_conv; subst.
-        destruct (v2 =? n) eqn:?; try rewrite Nat.eqb_eq in *;
-          try rewrite Nat.eqb_neq in *.
-        { exists v1; subst. exists m; repeat split; try auto.
-          eapply FPRangeValidator_sound; eauto.
-          set_tac. split; try auto.
-          split; try auto.
-          hnf; intros; subst; set_tac. }
-        { apply H9.
-          rewrite NatSet.add_spec in H5; destruct H5;
-            auto; subst; congruence. }
-  - destruct H5. destruct H4. destruct H6. eapply FPRangeValidator_sound; eauto.
+    * intros. unfold updEnv.
+      type_conv; subst.
+      destruct (v2 =? n) eqn:?; try rewrite Nat.eqb_eq in *;
+        try rewrite Nat.eqb_neq in *.
+      { exists v1; subst. exists m; repeat split; try auto.
+        eapply FPRangeValidator_sound; eauto.
+        set_tac. split; try auto.
+        split; try auto.
+        hnf; intros; subst; set_tac. }
+      { apply H9.
+        rewrite NatSet.add_spec in H5; destruct H5;
+          auto; subst; congruence. }
+  - destruct H5.
+    destruct H4.
+    destruct H6; auto.
+    eapply FPRangeValidator_sound; eauto.
 Qed.

coq/RoundoffErrorValidator.v

@@ -18,9 +18,7 @@ Definition RoundoffErrorValidator (e:expr Q) (tMap:FloverMap.t mType)
 
 Theorem RoundoffErrorValidator_sound:
   forall (e : expr Q) (E1 E2 : env) (fVars dVars : NatSet.t) (A : analysisResult)
-    (nR : R) (err : error) (iv : intv) (Gamma : FloverMap.t mType) DeltaMap,
-    (forall (e' : expr R) (m' : mType),
-        exists d : R, DeltaMap e' m' = Some d /\ (Rabs d <= mTypeToR m')%R) ->
+    (nR : R) (err : error) (iv : intv) (Gamma : FloverMap.t mType),