[WIP] Change the proofs to account for DeltaMap[s]

coq/CommandsDeterministic.v

@@ -2,7 +2,7 @@
  Formalization of the Abstract Syntax Tree of a subset used in the Flover framework
  **)
 Require Import Coq.Reals.Reals Coq.QArith.QArith.
-Require Export Flover.ExpressionSemanticsDeterministic Flover.Commands.
+Require Export Flover.Commands.
 Require Export Flover.Infra.ExpressionAbbrevs Flover.Infra.NatSet.
 
 (**

coq/ErrorBounds.v

@@ -43,7 +43,9 @@ 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)))
-            DeltaMap
+            (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
+                     else None)
             (Binop Plus (Var R 1) (Var R 2)) vF m ->
   (Rabs (e1R - e1F) <= Q2R err1)%R ->
   (Rabs (e2R - e2F) <= Q2R err2)%R ->
@@ -114,7 +116,9 @@ 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)))
-            DeltaMap
+            (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
+                     else None)
             (Binop Sub (Var R 1) (Var R 2)) vF m ->
   (Rabs (e1R - e1F) <= Q2R err1)%R ->
   (Rabs (e2R - e2F) <= Q2R err2)%R ->
@@ -190,7 +194,9 @@ 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)))
-            DeltaMap
+            (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
+                     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.
 Proof.
@@ -239,7 +245,9 @@ 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)))
-            DeltaMap
+            (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
+                     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.
 Proof.
@@ -293,7 +301,9 @@ 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))))
-            DeltaMap
+            (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
+                     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.
 Proof.
@@ -356,7 +366,9 @@ 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))
-            DeltaMap
+            (fun x _ => if R_orderedExps.eq_dec x (Downcast mEps (Var R 1))
+                     then DeltaMap (Downcast mEps e) mEps
+                     else None)
             (toRExp (Downcast mEps (Var Q 1))) nF mEps->
   (Rabs (nR - nF1) <= err)%R ->
   (Rabs (nR - nF) <= err + computeErrorR nF1 mEps)%R.

coq/ExpressionSemantics.v

@@ -300,8 +300,9 @@ Lemma binary_unfolding b f1 f2 E v1 v2 m1 m2 m Gamma DeltaMap delta:
   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 m => if R_orderedExps.eq_dec x (Binop b (Var R 1) (Var R 2))
-                     then Some delta else None)
+            (fun x _ => if R_orderedExps.eq_dec x (Binop b (Var R 1) (Var R 2))
+                     then DeltaMap (Binop b f1 f2) m
+                     else None)
             (Binop b (Var R 1) (Var R 2)) (perturb (evalBinop b v1 v2) m delta) m.
 Proof.
   intros no_div_zero err_v delta_map eval_f1 eval_f2 eval_float.
@@ -335,8 +336,9 @@ 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 m => if R_orderedExps.eq_dec x (Fma (Var R 1) (Var R 2) (Var R 3))
-                     then Some delta else None)
+            (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
+                     else None)
             (Fma (Var R 1) (Var R 2) (Var R 3)) (perturb (evalFma v1 v2 v3) m delta) m.
 Proof.
   intros err_v delta_map eval_f1 eval_f2 eval_f3 eval_float.
@@ -402,6 +404,38 @@ Proof.
         set_tac.
 Qed.
 
+Lemma eval_expr_det_ignore_bind2 e:
+  forall x v v_new m Gamma E DeltaMap,
+    eval_expr (updEnv x v_new E) Gamma DeltaMap e v m ->
+    ~ NatSet.In x (usedVars e) ->
+    eval_expr E Gamma DeltaMap e v m.
+Proof.
+  induction e; intros * eval_e no_usedVar *; cbn in *;
+    inversion eval_e; subst; try eauto.
+  - assert (n <> x).
+    { hnf. intros. subst. apply no_usedVar; set_tac. }
+    rewrite <- Nat.eqb_neq in H.
+    eapply Var_load.
+    + unfold updDefVars.
+      cbn.
+      apply beq_nat_false in H.
+      destruct (n ?= x)%nat eqn:?; try auto.
+    + unfold updEnv.
+      rewrite <- H1.
+      unfold updEnv.
+      now rewrite H.
+  - eapply Binop_dist'; eauto;
+      [ eapply IHe1 | eapply IHe2];
+      eauto;
+      hnf; intros; eapply no_usedVar;
+      set_tac.
+  - eapply Fma_dist'; eauto;
+      [eapply IHe1 | eapply IHe2 | eapply IHe3];
+      eauto;
+      hnf; intros; eapply no_usedVar;
+        set_tac.
+Qed.
+
 Lemma swap_Gamma_eval_expr e E vR m Gamma1 Gamma2 DeltaMap:
   (forall e, Gamma1 e = Gamma2 e) ->
   eval_expr E Gamma1 DeltaMap e vR m ->
@@ -428,7 +462,7 @@ Proof.
   intros x; destruct (R_orderedExps.compare x n); auto.
 Qed.
 
-Lemma eval_expr_fixed_DeltaMap_functional E Gamma DeltaMap e v1 v2 m:
+Lemma eval_expr_functional E Gamma DeltaMap e v1 v2 m:
   eval_expr E Gamma DeltaMap e v1 m ->
   eval_expr E Gamma DeltaMap e v2 m ->
   v1 = v2.

coq/FPRangeValidator.v

@@ -70,10 +70,10 @@ Ltac prove_fprangeval m v L1 R:=
   destruct (Rle_lt_dec (Rabs v) (Q2R (maxValue m)))%R; lra.
 
 Theorem FPRangeValidator_sound:
-  forall (e:expr Q) E1 E2 Gamma v m A fVars dVars,
+  forall (e:expr Q) E1 E2 Gamma DeltaMap v m A fVars dVars,
   approxEnv E1 (toRExpMap Gamma) A fVars dVars E2 ->
-  eval_expr E2 (toRExpMap Gamma) (toRExp e) v m ->
-  validTypes e Gamma ->
+  eval_expr E2 (toRExpMap Gamma) DeltaMap (toRExp e) v m ->
+  validTypes e Gamma DeltaMap ->
   validRanges e A E1 (toRTMap (toRExpMap Gamma)) ->
   validErrorbound e Gamma A dVars = true ->
   FPRangeValidator e A Gamma dVars = true ->
@@ -241,4 +241,4 @@ Proof.
           rewrite NatSet.add_spec in H4; destruct H4;
             auto; subst; congruence. }
   - destruct H4. destruct H3. eapply FPRangeValidator_sound; eauto.
-Qed.
\ No newline at end of file
+Qed.

coq/RoundoffErrorValidator.v

@@ -3,7 +3,7 @@ From Coq
 
 From Flover
      Require Export Infra.ExpressionAbbrevs ErrorAnalysis ErrorValidation
-     ErrorValidationAA ExpressionSemanticsDeterministic RealRangeValidator
+     ErrorValidationAA ExpressionSemantics RealRangeValidator
      TypeValidator Environments.
 
 Definition RoundoffErrorValidator (e:expr Q) (tMap:FloverMap.t mType)
@@ -21,10 +21,10 @@ Theorem RoundoffErrorValidator_sound:
     (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) ->
-    validTypes e Gamma ->
+    validTypes e Gamma DeltaMap ->
     approxEnv E1 (toRExpMap Gamma) A fVars dVars E2 ->
     NatSet.Subset (usedVars e -- dVars) fVars ->
-    eval_expr_det E1 (toRTMap (toRExpMap Gamma)) (fun x m => Some 0%R) (toREval (toRExp e)) nR REAL ->
+    eval_expr E1 (toRTMap (toRExpMap Gamma)) DeltaMapR (toREval (toRExp e)) nR REAL ->
     RoundoffErrorValidator e Gamma A dVars = true ->
     validRanges e A E1 (toRTMap (toRExpMap Gamma)) ->
     FloverMap.find e A = Some (iv, err) ->
@@ -34,7 +34,7 @@ Proof.
   unfold RoundoffErrorValidator.
   intros; cbn in *.
   destruct (validErrorbound e Gamma A dVars) eqn: Hivvalid.
-  - eapply validErrorbound_sound; eauto.
+  - admit.
   - destruct (validErrorboundAA e Gamma A dVars 1 (FloverMap.empty (affine_form Q))) eqn: Hafvalid;
       [|congruence].
     destruct p as (expr_map, noise).
@@ -58,7 +58,7 @@ Proof.
         [now rewrite FloverMapFacts.P.F.empty_in_iff|].
       split; eauto.
       eapply Hall; eauto; now rewrite FloverMapFacts.P.F.empty_in_iff.
-Qed.
+Admitted.
 
 Definition RoundoffErrorValidatorCmd (f:cmd Q) (tMap:FloverMap.t mType)
            (A:analysisResult) (dVars:NatSet.t) :=
@@ -71,19 +71,21 @@ Definition RoundoffErrorValidatorCmd (f:cmd Q) (tMap:FloverMap.t mType)
        end.
 
 Theorem RoundoffErrorValidatorCmd_sound f:
-  forall A E1 E2 outVars fVars dVars vR elo ehi err Gamma,
+  forall A E1 E2 outVars fVars dVars vR elo ehi err Gamma DeltaMap,
+    (forall (e' : expr R) (m' : mType),
+        exists d : R, DeltaMap e' m' = Some d /\ (Rabs d <= mTypeToR m')%R) ->
     approxEnv E1 (toRExpMap Gamma) A fVars dVars E2 ->
     ssa f (NatSet.union fVars dVars) outVars ->
     NatSet.Subset (NatSet.diff (Commands.freeVars f) dVars) fVars ->
-    bstep (toREvalCmd (toRCmd f)) E1 (toRTMap (toRExpMap Gamma)) vR REAL ->
+    bstep (toREvalCmd (toRCmd f)) E1 (toRTMap (toRExpMap Gamma)) DeltaMapR vR REAL ->
     validErrorboundCmd f Gamma A dVars = true ->
     validRangesCmd f A E1 (toRTMap (toRExpMap Gamma)) ->
-    validTypesCmd f Gamma ->
+    validTypesCmd f Gamma DeltaMap ->
     FloverMap.find (getRetExp f) A = Some ((elo,ehi),err) ->
     (exists vF m,
-        bstep (toRCmd f) E2 (toRExpMap Gamma) vF m) /\
+        bstep (toRCmd f) E2 (toRExpMap Gamma) DeltaMap vF m) /\
     (forall vF mF,
-    bstep (toRCmd f) E2 (toRExpMap Gamma) vF mF ->
+    bstep (toRCmd f) E2 (toRExpMap Gamma) DeltaMap vF mF ->
     (Rabs (vR - vF) <= (Q2R err))%R).
 Proof.
   intros.

coq/ssaPrgs.v

@@ -211,18 +211,31 @@ Proof.
 Qed.
 
 Lemma eval_expr_ssa_extension (e: expr R) (e' : expr Q) E Gamma DeltaMap
-      vR vR' m n c fVars dVars outVars:
+      vR vR' m m__e n c fVars dVars outVars:
   ssa (Let m n e' c) (fVars ∪ dVars) outVars ->
   NatSet.Subset (usedVars e) (fVars ∪ dVars) ->
   ~ (n ∈ fVars ∪ dVars) ->
-  eval_expr E Gamma DeltaMap e vR REAL ->
-  eval_expr (updEnv n vR' E) Gamma DeltaMap e vR REAL.
+  eval_expr E Gamma DeltaMap e vR m__e ->
+  eval_expr (updEnv n vR' E) Gamma DeltaMap e vR m__e.
 Proof.
   intros Hssa Hsub Hnotin Heval.
   eapply eval_expr_ignore_bind; [auto |].
   edestruct ssa_inv_let; eauto.
 Qed.
 
+Lemma eval_expr_ssa_extension2 (e: expr R) (e' : expr Q) E Gamma DeltaMap
+      v v' m__e m n c fVars dVars outVars:
+  ssa (Let m__e n e' c) (fVars ∪ dVars) outVars ->
+  NatSet.Subset (usedVars e) (fVars ∪ dVars) ->
+  ~ (n ∈ fVars ∪ dVars) ->
+  eval_expr (updEnv n v' E) Gamma DeltaMap e v m ->
+  eval_expr E Gamma DeltaMap e v m.
+Proof.
+  intros Hssa Hsub Hnotin Heval.
+  eapply eval_expr_det_ignore_bind2; [eauto |].
+  edestruct ssa_inv_let; eauto.
+Qed.
+
 (*
 Lemma shadowing_free_rewriting_expr e v E1 E2 defVars:
   (forall n, E1 n = E2 n)->