Merge branch 'certificates' of https://gitlab.mpi-sws.org/AVA/daisy into fma_proofs_merge

Conflicts:
	coq/ErrorValidation.v
	coq/Expressions.v
	coq/FPRangeValidator.v
	coq/IEEE_connection.v
	coq/Infra/Ltacs.v
	coq/IntervalValidation.v
	coq/Typing.v

README.md

@@ -112,7 +112,7 @@ $ git submodule init
 
 Then, initialize the CakeML submodule and start compilation:
 ```bash
-$ git submodule update --recursive --remote
+$ git submodule update --recursive
 $ cd hol4/
 $ Holmake
 ```

coq/CertificateChecker.v

@@ -13,9 +13,11 @@ Require Export Daisy.Infra.ExpressionAbbrevs Daisy.Commands.
 
 (** Certificate checking function **)
 Definition CertificateChecker (e:exp Q) (absenv:analysisResult) (P:precond) (defVars:nat -> option mType) :=
-  if (typeCheck e defVars (typeMap defVars e)) then
-    if (validIntervalbounds e absenv P NatSet.empty) && FPRangeValidator e absenv (typeMap defVars e) NatSet.empty
-    then (validErrorbound e (typeMap defVars e) absenv NatSet.empty)
+  let tMap := (typeMap defVars e (DaisyMap.empty mType)) in
+  if (typeCheck e defVars tMap)
+  then
+    if (validIntervalbounds e absenv P NatSet.empty) && FPRangeValidator e absenv tMap NatSet.empty
+    then (validErrorbound e tMap absenv NatSet.empty)
     else false
   else false.
 
@@ -27,19 +29,20 @@ Definition CertificateChecker (e:exp Q) (absenv:analysisResult) (P:precond) (def
 Theorem Certificate_checking_is_sound (e:exp Q) (absenv:analysisResult) P defVars:
   forall (E1 E2:env),
     approxEnv E1 defVars absenv (usedVars e) NatSet.empty E2 ->
-    (forall v, NatSet.mem v (Expressions.usedVars e) = true ->
+    (forall v, NatSet.In v (Expressions.usedVars e) ->
           exists vR, E1 v = Some vR /\
                 (Q2R (fst (P v)) <= vR <= Q2R (snd (P v)))%R) ->
-    (forall v, (v) mem (usedVars e) = true ->
+    (forall v, NatSet.In v  (usedVars e) ->
           exists m : mType,
             defVars v = Some m) ->
     CertificateChecker e absenv P defVars = true ->
-   exists vR vF m,
-    eval_exp E1 (toRMap defVars) (toREval (toRExp e)) vR M0 /\
-    eval_exp E2 defVars (toRExp e) vF m /\
-    (forall vF m,
-        eval_exp E2 defVars (toRExp e) vF m ->
-        (Rabs (vR - vF) <= Q2R (snd (absenv e))))%R.
+    exists iv err vR vF m,
+      DaisyMap.find e absenv = Some (iv, err) /\
+      eval_exp E1 (toRMap defVars) (toREval (toRExp e)) vR M0 /\
+      eval_exp E2 defVars (toRExp e) vF m /\
+      (forall vF m,
+          eval_exp E2 defVars (toRExp e) vF m ->
+          (Rabs (vR - vF) <= Q2R err))%R.
 (**
    The proofs is a simple composition of the soundness proofs for the range
    validator and the error bound validator.
@@ -49,55 +52,52 @@ Proof.
   unfold CertificateChecker in certificate_valid.
   rewrite <- andb_lazy_alt in certificate_valid.
   andb_to_prop certificate_valid.
-  env_assert absenv e env_e.
-  destruct env_e as [iv [err absenv_eq]].
-  destruct iv as [ivlo ivhi].
-  rewrite absenv_eq; simpl.
   pose proof (NatSetProps.empty_union_2 (Expressions.usedVars e) NatSet.empty_spec) as union_empty.
   hnf in union_empty.
-  assert (forall v1, (v1) mem (Expressions.usedVars e ∪ NatSet.empty) = true ->
-                exists m0 : mType, defVars v1 = Some m0).
-  { intros; eapply types_defined.
-    rewrite NatSet.mem_spec in *.
-    rewrite <- union_empty; eauto. }
+  assert (dVars_range_valid NatSet.empty E1 absenv).
+  { unfold dVars_range_valid.
+    intros; set_tac. }
   assert (NatSet.Subset (usedVars e -- NatSet.empty) (Expressions.usedVars e)).
   { hnf; intros a in_empty.
     set_tac. }
+  assert (vars_typed (usedVars e ∪ NatSet.empty) defVars).
+  { unfold vars_typed. intros; apply types_defined. set_tac. destruct H1; set_tac.
+    split; try auto. hnf; intros; set_tac. }
   rename R into validFPRanges.
-  assert (forall v, (v) mem (NatSet.empty) = true -> exists vR :R, E1 v = Some vR /\ (Q2R (fst (fst (absenv (Var Q v)))) <= vR <= Q2R (snd (fst (absenv (Var Q v)))))%R).
-  { intros v v_in_empty.
-    rewrite NatSet.mem_spec in v_in_empty.
-    inversion v_in_empty. }
-  edestruct validIntervalbounds_sound as [vR [eval_real real_bounds_e]]; eauto.
-  destruct (validErrorbound_sound e P (typeMap defVars e) L approxE1E2 H0 eval_real R0 L1 H1 P_valid H absenv_eq) as [[vF [mF eval_float]] err_bounded]; auto.
-  exists vR; exists vF; exists mF; split; auto.
+  edestruct (validIntervalbounds_sound e (A:=absenv) (P:=P) (fVars:=usedVars e) (dVars:=NatSet.empty) (Gamma:=defVars) (E:=E1))
+    as [iv_e [ err_e [vR [ map_e [eval_real real_bounds_e]]]]]; eauto.
+  destruct iv_e as [elo ehi].
+  edestruct (validErrorbound_sound e (typeMap defVars e (DaisyMap.empty mType)) L approxE1E2 H0 eval_real R0 L1 H P_valid H1 map_e) as [[vF [mF eval_float]] err_bounded]; auto.
+  exists (elo, ehi), err_e, vR, vF, mF; split; auto.
 Qed.
 
 Definition CertificateCheckerCmd (f:cmd Q) (absenv:analysisResult) (P:precond) defVars:=
-  if (typeCheckCmd f defVars (typeMapCmd defVars f) && validSSA f (freeVars f))
+  let tMap := typeMapCmd defVars f (DaisyMap.empty mType) in
+  if (typeCheckCmd f defVars tMap && validSSA f (freeVars f))
   then
     if (validIntervalboundsCmd f absenv P NatSet.empty) &&
-       FPRangeValidatorCmd f absenv (typeMapCmd defVars f) NatSet.empty
-    then (validErrorboundCmd f (typeMapCmd defVars f) absenv NatSet.empty)
+       FPRangeValidatorCmd f absenv tMap NatSet.empty
+    then (validErrorboundCmd f tMap absenv NatSet.empty)
     else false
   else false.
 
 Theorem Certificate_checking_cmds_is_sound (f:cmd Q) (absenv:analysisResult) P defVars:
   forall (E1 E2:env),
     approxEnv E1 defVars absenv (freeVars f) NatSet.empty E2 ->
-    (forall v, NatSet.mem v (freeVars f)= true ->
+    (forall v, NatSet.In v (freeVars f) ->
           exists vR, E1 v = Some vR /\
                 (Q2R (fst (P v)) <= vR <= Q2R (snd (P v)))%R) ->
-    (forall v, (v) mem (freeVars f) = true ->
+    (forall v, NatSet.In v (freeVars f) ->
           exists m : mType,
             defVars v = Some m) ->
     CertificateCheckerCmd f absenv P defVars = true ->
-    exists vR vF m,
+    exists iv err vR vF m,
+      DaisyMap.find  (getRetExp f) absenv = Some (iv,err) /\
     bstep (toREvalCmd (toRCmd f)) E1 (toRMap defVars) vR M0 /\
     bstep (toRCmd f) E2 defVars vF m /\
     (forall vF m,
         bstep (toRCmd f) E2 defVars vF m ->
-        (Rabs (vR - vF) <= Q2R (snd (absenv (getRetExp f))))%R).
+        (Rabs (vR - vF) <= Q2R (err))%R).
 (**
    The proofs is a simple composition of the soundness proofs for the range
    validator and the error bound validator.
@@ -109,32 +109,25 @@ Proof.
   andb_to_prop certificate_valid.
   apply validSSA_sound in R0.
   destruct R0 as [outVars ssa_f].
-  env_assert absenv (getRetExp f) env_f.
-  destruct env_f as [iv [err absenv_eq]].
-  destruct iv as [ivlo ivhi].
   assert (ssa f (freeVars f ∪ NatSet.empty) outVars) as ssa_valid.
   { eapply ssa_equal_set; try eauto.
     apply NatSetProps.empty_union_2.
     apply NatSet.empty_spec. }
   rename R into validFPRanges.
-  assert (forall v, (v) mem (NatSet.empty) = true ->
-               exists vR : R,
-                 E1 v = Some vR /\ (Q2R (fst (fst (absenv (Var Q v)))) <= vR <= Q2R (snd (fst (absenv (Var Q v)))))%R) as no_dVars_valid.
-  { intros v v_in_empty.
-    set_tac. inversion v_in_empty. }
-  assert (forall v, (v) mem (freeVars f ∪ NatSet.empty) = true ->
-               exists m : mType, defVars v = Some m) as types_valid.
-  { intros v v_mem; apply types_defined.
-    set_tac. rewrite NatSet.union_spec in v_mem.
-    destruct v_mem; try auto.
-    inversion H. }
+  assert (dVars_range_valid NatSet.empty E1 absenv).
+  { unfold dVars_range_valid.
+    intros; set_tac. }
+  assert (vars_typed (freeVars f ∪ NatSet.empty) defVars).
+  { unfold vars_typed. intros; apply types_defined. set_tac.
+    destruct H0; set_tac. }
   assert (NatSet.Subset (freeVars f -- NatSet.empty) (freeVars f))
     as freeVars_contained by set_tac.
-  edestruct (validIntervalboundsCmd_sound) as [vR [eval_real bounded_real_f]] ; eauto.
-  rewrite absenv_eq; simpl.
+  edestruct (validIntervalboundsCmd_sound)
+    as [iv [ err [vR [map_f [eval_real bounded_real_f]]]]]; eauto.
+  destruct iv as [f_lo f_hi].
   edestruct validErrorboundCmd_gives_eval as [vF [mF eval_float]]; eauto.
-  exists vR; exists vF; exists mF; split; try auto.
-  split; try auto.
+  exists (f_lo, f_hi), err, vR, vF, mF; split; try auto.
+  split; try auto; split; try auto.
   intros.
   eapply validErrorboundCmd_sound; eauto.
 Qed.
\ No newline at end of file

coq/Environments.v

@@ -20,124 +20,113 @@ Inductive approxEnv : env -> (nat -> option mType) -> analysisResult -> NatSet.t
    (Rabs (v1 - v2) <= (Rabs v1) * Q2R (mTypeToQ m))%R ->
    NatSet.mem x (NatSet.union fVars dVars) = false ->
    approxEnv (updEnv x v1 E1) (updDefVars x m defVars) A (NatSet.add x fVars) dVars (updEnv x v2 E2)
-|approxUpdBound E1 E2 defVars A v1 v2 x fVars dVars m:
+|approxUpdBound E1 E2 defVars A v1 v2 x fVars dVars m iv err:
    approxEnv E1 defVars A fVars dVars E2 ->
-   (Rabs (v1 - v2) <= Q2R (snd (A (Var Q x))))%R ->
+   DaisyMap.find (Var Q x) A = Some (iv, err) ->
+   (Rabs (v1 - v2) <= Q2R err)%R ->
    NatSet.mem x (NatSet.union fVars dVars) = false ->
    approxEnv (updEnv x v1 E1) (updDefVars x m defVars) A fVars (NatSet.add x dVars) (updEnv x v2 E2).
 
-(* Inductive approxParams :env -> env -> Prop := *)
-(* |approxParamRefl: *)
-(*    approxParams emptyEnv emptyEnv *)
-(* |approxParamUpd E1 E2 m x v1 v2 : *)
-(*    approxParams E1 E2 -> *)
-(*    (Rabs (v1 - v2) <= Q2R (meps m))%R -> *)
-(*    approxParams (updEnv x M0 v1 E1) (updEnv x m v2 E2). *)
-
 Section RelationProperties.
 
-  Variable (x:nat) (v:R) (E1 E2:env) (Gamma:nat -> option mType) (A:analysisResult) (fVars dVars: NatSet.t).
+  Variable (x:nat) (v:R) (E1 E2:env) (Gamma:nat -> option mType)
+           (A:analysisResult) (fVars dVars: NatSet.t).
 
   Hypothesis approxEnvs: approxEnv E1 Gamma A fVars dVars E2.
 
-Lemma approxEnv_gives_value:
-  E1 x = Some v ->
-  NatSet.In x (NatSet.union fVars  dVars) ->
-  exists v',
-    E2 x = Some v'.
-Proof.
-  induction approxEnvs;
-    intros E1_def x_valid.
-  - unfold emptyEnv in E1_def; simpl in E1_def. congruence.
-  - unfold updEnv in *.
-    case_eq (x =? x0); intros eq_case; rewrite eq_case in *.
-    + eexists; eauto.
-    + eapply IHa; auto.
-      set_tac.
-      rewrite NatSet.union_spec in x_valid.
-      destruct x_valid; set_tac.
-      rewrite NatSet.add_spec in H1.
-      destruct H1; subst; try auto.
-      rewrite Nat.eqb_refl in eq_case; congruence.
-  - unfold updEnv in *.
-    case_eq (x =? x0); intros eq_case; rewrite eq_case in *.
-    + eexists; eauto.
-    + eapply IHa; auto.
-      set_tac.
-      rewrite NatSet.union_spec in x_valid.
-      destruct x_valid; set_tac.
-      rewrite NatSet.add_spec in H1.
-      destruct H1; subst; try auto.
-      rewrite Nat.eqb_refl in eq_case; congruence.
-Qed.
+  Lemma approxEnv_gives_value:
+    E1 x = Some v ->
+    NatSet.In x (NatSet.union fVars  dVars) ->
+    exists v',
+      E2 x = Some v'.
+  Proof.
+    induction approxEnvs;
+      intros E1_def x_valid.
+    - unfold emptyEnv in E1_def; simpl in E1_def. congruence.
+    - unfold updEnv in *.
+      case_eq (x =? x0); intros eq_case; rewrite eq_case in *.
+      + eexists; eauto.
+      + eapply IHa; eauto.
+        set_tac.
+        destruct x_valid; set_tac.
+        destruct H1 as [? | [? ?]]; subst; try auto.
+        rewrite Nat.eqb_refl in eq_case; congruence.
+    - unfold updEnv in *.
+      case_eq (x =? x0); intros eq_case; rewrite eq_case in *.
+      + eexists; eauto.
+      + eapply IHa; auto.
+        set_tac.
+        destruct x_valid; set_tac.
+        destruct H2 as [? | [ ? ?]]; subst; try auto.
+        rewrite Nat.eqb_refl in eq_case; congruence.
+  Qed.
 
-Arguments mTypeToQ _ : simpl nomatch.
+  Arguments mTypeToQ _ : simpl nomatch.
 
-Lemma approxEnv_fVar_bounded v2 m:
-  E1 x = Some v ->
-  E2 x = Some v2 ->
-  NatSet.In x fVars ->
-  Gamma x = Some m ->
-  (Rabs (v - v2) <= (Rabs v) * Q2R (mTypeToQ m))%R.
-Proof.
-  induction approxEnvs;
-    intros E1_def E2_def x_free x_typed.
-  - unfold emptyEnv in *; simpl in *; congruence.
-  - set_tac.
-    rewrite add_spec_strong in x_free.
-    destruct x_free as [x_x0 | [x_neq x_free]]; subst.
-    + unfold updEnv in *;
-        rewrite Nat.eqb_refl in *; simpl in *.
-      unfold updDefVars in x_typed.
-      rewrite Nat.eqb_refl in x_typed.
-      inversion x_typed; subst.
-      inversion E1_def; inversion E2_def; subst; auto.
-    + unfold updEnv in *; simpl in *.
-      rewrite <- Nat.eqb_neq in x_neq.
-      rewrite x_neq in *; simpl in *.
-      unfold updDefVars in x_typed; rewrite x_neq in x_typed.
+  Lemma approxEnv_fVar_bounded v2 m:
+    E1 x = Some v ->
+    E2 x = Some v2 ->
+    NatSet.In x fVars ->
+    Gamma x = Some m ->
+    (Rabs (v - v2) <= (Rabs v) * Q2R (mTypeToQ m))%R.
+  Proof.
+    induction approxEnvs;
+      intros E1_def E2_def x_free x_typed.
+    - unfold emptyEnv in *; simpl in *; congruence.
+    - set_tac.
+      destruct x_free as [x_x0 | [x_neq x_free]]; subst.
+      + unfold updEnv in *;
+          rewrite Nat.eqb_refl in *; simpl in *.
+        unfold updDefVars in x_typed.
+        rewrite Nat.eqb_refl in x_typed.
+        inversion x_typed; subst.
+        inversion E1_def; inversion E2_def; subst; auto.
+      + unfold updEnv in *; simpl in *.
+        rewrite <- Nat.eqb_neq in x_neq.
+        rewrite x_neq in *; simpl in *.
+        unfold updDefVars in x_typed; rewrite x_neq in x_typed.
+        apply IHa; auto.
+    - assert (x =? x0 = false) as x_x0_neq.
+      { rewrite Nat.eqb_neq; hnf; intros; subst.
+        set_tac.
+        apply H1.
+        set_tac. }
+      unfold updEnv in *; rewrite x_x0_neq in *.
       apply IHa; auto.
-  - assert (x =? x0 = false) as x_x0_neq.
-    { rewrite Nat.eqb_neq; hnf; intros; subst.
-      set_tac.
-      apply H0.
-      set_tac. }
-    unfold updEnv in *; rewrite x_x0_neq in *.
-    apply IHa; auto.
-    unfold updDefVars in x_typed;
-      rewrite x_x0_neq in x_typed; auto.
-Qed.
+      unfold updDefVars in x_typed;
+        rewrite x_x0_neq in x_typed; auto.
+  Qed.
 
-Lemma approxEnv_dVar_bounded v2 m e:
-  E1 x = Some v ->
-  E2 x = Some v2 ->
-  NatSet.In x dVars ->
-  Gamma x = Some m ->
-  snd (A (Var Q x)) = e ->
-  (Rabs (v - v2) <= Q2R e)%R.
-Proof.
-  induction approxEnvs;
-    intros E1_def E2_def x_def x_typed A_e; subst.
-  - unfold emptyEnv in *; simpl in *; congruence.
-  - assert (x =? x0 = false) as x_x0_neq.
-    { rewrite Nat.eqb_neq; hnf; intros; subst.
-      set_tac.
-      apply H0; set_tac.
-    }
-    unfold updEnv in *; rewrite x_x0_neq in *.
-    unfold updDefVars in x_typed; rewrite x_x0_neq in x_typed.
-    apply IHa; auto.
-  - set_tac.
-    rewrite add_spec_strong in x_def.
-    destruct x_def as [x_x0 | [x_neq x_def]]; subst.
-    + unfold updEnv in *;
-        rewrite Nat.eqb_refl in *; simpl in *.
-      inversion E1_def; inversion E2_def; subst; auto.
-    + unfold updEnv in *; simpl in *.
-      rewrite <- Nat.eqb_neq in x_neq.
-      rewrite x_neq in *; simpl in *.
-      unfold updDefVars in x_typed; rewrite x_neq in x_typed.
+  Lemma approxEnv_dVar_bounded v2 m iv e:
+    E1 x = Some v ->
+    E2 x = Some v2 ->
+    NatSet.In x dVars ->
+    Gamma x = Some m ->
+    DaisyMap.find (Var Q x) A = Some (iv, e) ->
+    (Rabs (v - v2) <= Q2R e)%R.
+  Proof.
+    induction approxEnvs;
+      intros E1_def E2_def x_def x_typed A_e; subst.
+    - unfold emptyEnv in *; simpl in *; congruence.
+    - assert (x =? x0 = false) as x_x0_neq.
+      { rewrite Nat.eqb_neq; hnf; intros; subst.
+        set_tac.
+        apply H0; set_tac.
+      }
+      unfold updEnv in *; rewrite x_x0_neq in *.
+      unfold updDefVars in x_typed; rewrite x_x0_neq in x_typed.
       apply IHa; auto.
-Qed.
+    - set_tac.
+      destruct x_def as [x_x0 | [x_neq x_def]]; subst.
+      + unfold updEnv in *;
+          rewrite Nat.eqb_refl in *; simpl in *.
+        inversion E1_def; inversion E2_def; subst.
+        rewrite A_e in *; inversion H; auto.
+      + unfold updEnv in *; simpl in *.
+        rewrite <- Nat.eqb_neq in x_neq.
+        rewrite x_neq in *; simpl in *.
+        unfold updDefVars in x_typed; rewrite x_neq in x_typed.
+        apply IHa; auto.
+  Qed.
 
 End RelationProperties.
\ No newline at end of file

coq/FPRangeValidator.v

@@ -6,44 +6,44 @@ Require Import Coq.QArith.QArith Coq.QArith.Qreals Coq.Reals.Reals Coq.micromega
 Require Import Daisy.Infra.MachineType Daisy.Typing Daisy.Infra.RealSimps Daisy.IntervalValidation Daisy.ErrorValidation Daisy.Commands Daisy.Environments Daisy.ssaPrgs Daisy.Infra.Ltacs Daisy.Infra.RealRationalProps.
 
 Fixpoint FPRangeValidator (e:exp Q) (A:analysisResult) typeMap dVars {struct e} : bool :=
-  match typeMap e with
-  |Some m =>
-        let (iv_e, err_e) := A e in
-        let iv_e_float := widenIntv iv_e err_e in
-        let recRes :=
-            match e with
-            | Binop b e1 e2 =>
-              FPRangeValidator e1 A typeMap dVars &&
-              FPRangeValidator e2 A typeMap dVars
-            | Fma e1 e2 e3 =>
-              FPRangeValidator e1 A typeMap dVars &&
-              FPRangeValidator e2 A typeMap dVars &&
-              FPRangeValidator e3 A typeMap dVars
-            | Unop u e =>
-              FPRangeValidator e A typeMap dVars
-            | Downcast m e => FPRangeValidator e A typeMap dVars
-            | _ =>  true
-            end
-        in
-        match e with
-        | Var _ v =>
-          if NatSet.mem v dVars
-          then true
-          else
-            if (validValue (ivhi iv_e_float) m &&
-                validValue (ivlo iv_e_float) m)
-            then ((normal (ivlo iv_e_float) m) || (Qeq_bool (ivlo iv_e_float) 0)) &&
-                  (normal (ivhi iv_e_float) m || (Qeq_bool (ivhi iv_e_float) 0)) && recRes
-            else
-              false
-        | _ => if (validValue (ivhi iv_e_float) m &&
-                validValue (ivlo iv_e_float) m)
-              then ((normal (ivlo iv_e_float) m) || (Qeq_bool (ivlo iv_e_float) 0)) &&
-                  (normal (ivhi iv_e_float) m || (Qeq_bool (ivhi iv_e_float) 0)) && recRes
-              else
-                false
-        end
-  | None => false
+  match DaisyMap.find e typeMap, DaisyMap.find e A with
+  |Some m, Some (iv_e, err_e) =>
+   let iv_e_float := widenIntv iv_e err_e in
+   let recRes :=
+       match e with
+       | Binop b e1 e2 =>
+         FPRangeValidator e1 A typeMap dVars &&
+         FPRangeValidator e2 A typeMap dVars
+       | Fma e1 e2 e3 =>
+         FPRangeValidator e1 A typeMap dVars &&
+         FPRangeValidator e2 A typeMap dVars &&
+         FPRangeValidator e3 A typeMap dVars
+       | Unop u e =>
+         FPRangeValidator e A typeMap dVars
+       | Downcast m e => FPRangeValidator e A typeMap dVars
+       | _ =>  true
+       end
+   in
+   match e with
+   | Var _ v =>
+     if NatSet.mem v dVars
+     then true
+     else
+       if (validValue (ivhi iv_e_float) m &&
+           validValue (ivlo iv_e_float) m)
+       then ((normal (ivlo iv_e_float) m) || (Qeq_bool (ivlo iv_e_float) 0)) &&
+             (normal (ivhi iv_e_float) m || (Qeq_bool (ivhi iv_e_float) 0)) &&
+              recRes
+       else
+         false
+   | _ => if (validValue (ivhi iv_e_float) m &&
+              validValue (ivlo iv_e_float) m)
+         then ((normal (ivlo iv_e_float) m) || (Qeq_bool (ivlo iv_e_float) 0)) &&
+               (normal (ivhi iv_e_float) m || (Qeq_bool (ivhi iv_e_float) 0)) && recRes
+         else
+           false
+   end
+  | _, _ => false
   end.
 
 Fixpoint FPRangeValidatorCmd (f:cmd Q) (A:analysisResult) typeMap dVars :=
@@ -81,77 +81,54 @@ Theorem FPRangeValidator_sound:
   validErrorbound e tMap A dVars = true ->
   FPRangeValidator e A tMap dVars = true ->
   NatSet.Subset (NatSet.diff (usedVars e) dVars) fVars ->
-  (forall v, NatSet.In v fVars ->
-        exists vR, E1 v = Some vR /\ Q2R (fst (P v)) <= vR <= Q2R (snd (P v)))%R ->
-  (forall v, NatSet.In v fVars \/ NatSet.In v dVars ->
-        exists m, Gamma v = Some m) ->
-  (forall v, NatSet.In v dVars ->
-        exists vR, E1 v = Some vR /\
-              Q2R (fst (fst (A (Var Q v)))) <= vR <= Q2R (snd (fst (A (Var Q v)))))%R ->
-  (forall v, NatSet.In v dVars ->
-        exists vF m, E2 v = Some vF /\ tMap (Var Q v) = Some m /\ validFloatValue vF m) ->
+  dVars_range_valid dVars E1 A ->
+  fVars_P_sound fVars E1 P ->
+  vars_typed (NatSet.union fVars dVars) Gamma ->
+ (forall v, NatSet.In v dVars ->
+        exists vF m, E2 v = Some vF /\ DaisyMap.find (Var Q v) tMap = Some m /\ validFloatValue vF m) ->
   validFloatValue v m.
 Proof.
   intros *.
   unfold FPRangeValidator.
   intros.
-  destruct (A e) as [iv_e err_e] eqn:?;
-    destruct iv_e as [e_lo e_hi] eqn:?; simpl in *.
-  assert (tMap e = Some m)
+  assert (DaisyMap.find e tMap = Some m)
     as type_e
       by (eapply typingSoundnessExp; eauto).
-  subst; simpl in *.
   unfold validFloatValue.
-  assert (exists vR, eval_exp E1 (toRMap Gamma) (toREval (toRExp e)) vR M0 /\
-                Q2R (fst (fst (A e))) <= vR <= Q2R (snd (fst (A e))))%R
-         as eval_real_exists.
-  { eapply validIntervalbounds_sound; eauto.
-    - intros; apply H8.
-      rewrite <- NatSet.mem_spec; auto.
-    - intros. apply H6.
-      rewrite <- NatSet.mem_spec; auto.
-    - intros. apply H7.
-      set_tac.
-      rewrite <- NatSet.union_spec; auto. }
-  destruct eval_real_exists as [vR [eval_real vR_bounded]].
-  assert (Rabs (vR - v) <= Q2R (snd (A e)))%R.
-  { eapply validErrorbound_sound; eauto.
-    - intros * v1_dVar.
-      apply H8; set_tac.
-    - intros * v0_fVar.
-      apply H6. rewrite <- NatSet.mem_spec; auto.
-    - intros * v1_in_union.
-      apply H7; set_tac.
-      rewrite NatSet.union_spec in v1_in_union; auto.
-    - eauto ; instantiate (1:= e_hi).
-      instantiate (1:=e_lo). rewrite Heqp. reflexivity. }
-  rewrite Heqp in *; simpl in *.
+  edestruct (validIntervalbounds_sound e (A:=A) (P:=P))
+    as [iv_e [err_e [vR[ map_e[eval_real vR_bounded]]]]]; eauto.
+  destruct iv_e as  [e_lo e_hi].
+  assert (Rabs (vR - v) <= Q2R (err_e))%R.
+  { eapply validErrorbound_sound; eauto. }
   destruct (distance_gives_iv (a:=vR) v (e:=Q2R err_e) (Q2R e_lo, Q2R e_hi))
     as [v_in_errIv];
     try auto.
-  unfold IVlo, IVhi in *; simpl in *.
+  simpl in *.
   assert (Rabs v <= Rabs (Q2R e_hi + Q2R err_e) \/
           Rabs v <= Rabs (Q2R e_lo - Q2R err_e))%R
     as abs_bounded
     by (apply bounded_inAbs; auto).
   destruct e;
-    unfold validFloatValue in *; simpl in *;
-      rewrite type_e, Heqp in *; simpl in *.
+    unfold validFloatValue in *; cbn in *;
+      rewrite type_e in *; cbn in *.
   - destruct (n mem dVars) eqn:?; simpl in *.
     + destruct (H9 n); try set_tac.
       destruct H12 as [m2 [env_eq [map_eq validVal]]].
       inversion H0; subst.
       rewrite env_eq in H14; inversion H14; subst.
       rewrite map_eq in type_e; inversion type_e; subst; auto.
-    + andb_to_prop H4.
+    + Daisy_compute.
       prove_fprangeval m v L1 R.
-  - andb_to_prop H4.
-    prove_fprangeval m v L1 R.
-  - andb_to_prop H4.
-    prove_fprangeval m v L1 R.
-  - andb_to_prop H4.
+  - Daisy_compute.
     prove_fprangeval m v L1 R.
-  - andb_to_prop H4.
+  - Daisy_compute; try congruence.
+    type_conv; subst.
+    prove_fprangeval m0 v L1 R.
+  - Daisy_compute; try congruence.
+    type_conv; subst.
+    prove_fprangeval (join m0 m1) v L1 R.
+  - Daisy_compute; try congruence.
+    type_conv; subst.
     prove_fprangeval m v L1 R.
   - andb_to_prop H4.
     prove_fprangeval m v L1 R.
@@ -168,22 +145,11 @@ Lemma FPRangeValidatorCmd_sound (f:cmd Q):
   validErrorboundCmd f tMap A dVars = true ->
   FPRangeValidatorCmd f A tMap dVars = true ->
   NatSet.Subset (NatSet.diff (freeVars f) dVars) fVars ->
-  (forall v,
-      NatSet.In v fVars ->
-      exists vR, E1 v = Some vR /\ Q2R (fst (P v)) <= vR <= Q2R (snd (P v)))%R ->
-  (forall v,
-      NatSet.In v fVars \/ NatSet.In v dVars ->