(** Interval arithmetic checker and its soundness proof. The function validIntervalbounds checks wether the given analysis result is a valid range arithmetic for each sub term of the given expression e. The computation is done using our formalized interval arithmetic. The function is used in CertificateChecker.v to build the full checker. **) Require Import Coq.QArith.QArith Coq.QArith.Qreals QArith.Qminmax Coq.Lists.List Coq.micromega.Psatz. Require Import Daisy.Infra.Abbrevs Daisy.Infra.RationalSimps Daisy.Infra.RealRationalProps. Require Import Daisy.Infra.Ltacs Daisy.Infra.RealSimps Daisy.Typing. Require Export Daisy.IntervalArithQ Daisy.IntervalArith Daisy.ssaPrgs. Fixpoint validIntervalbounds (e:exp Q) (absenv:analysisResult) (P:precond) (validVars:NatSet.t) := let (intv, _) := absenv e in match e with | Var _ _ v => if NatSet.mem v validVars then true else isSupersetIntv (P v) intv && (Qleb (ivlo (P v)) (ivhi (P v))) | Const _ n => isSupersetIntv (n,n) intv | Unop o f => if validIntervalbounds f absenv P validVars then let (iv, _) := absenv f in match o with | Neg => let new_iv := negateIntv iv in isSupersetIntv new_iv intv | Inv => if (((Qleb (ivhi iv) 0) && (negb (Qeq_bool (ivhi iv) 0))) || ((Qleb 0 (ivlo iv)) && (negb (Qeq_bool (ivlo iv) 0)))) then let new_iv := invertIntv iv in isSupersetIntv new_iv intv else false end else false | Binop op f1 f2 => if ((validIntervalbounds f1 absenv P validVars) && (validIntervalbounds f2 absenv P validVars)) then let (iv1,_) := absenv f1 in let (iv2,_) := absenv f2 in match op with | Plus => let new_iv := addIntv iv1 iv2 in isSupersetIntv new_iv intv | Sub => let new_iv := subtractIntv iv1 iv2 in isSupersetIntv new_iv intv | Mult => let new_iv := multIntv iv1 iv2 in isSupersetIntv new_iv intv | Div => if (((Qleb (ivhi iv2) 0) && (negb (Qeq_bool (ivhi iv2) 0))) || ((Qleb 0 (ivlo iv2)) && (negb (Qeq_bool (ivlo iv2) 0)))) then let new_iv := divideIntv iv1 iv2 in isSupersetIntv new_iv intv else false end else false | Downcast _ f1 => let (iv1, _) := absenv f1 in andb (validIntervalbounds f1 absenv P validVars) (andb (isSupersetIntv intv iv1) (isSupersetIntv iv1 intv)) (* TODO: intv = iv1 might be a hard constraint... *) end. Fixpoint validIntervalboundsCmd (f:cmd Q) (absenv:analysisResult) (P:precond) (validVars:NatSet.t) :bool:= match f with | Let m x e g => if (validIntervalbounds e absenv P validVars && Qeq_bool (fst (fst (absenv e))) (fst (fst (absenv (Var Q m x)))) && Qeq_bool (snd (fst (absenv e))) (snd (fst (absenv (Var Q m x))))) then validIntervalboundsCmd g absenv P (NatSet.add x validVars) else false |Ret e => validIntervalbounds e absenv P validVars end. Theorem ivbounds_approximatesPrecond_sound f absenv P V: validIntervalbounds f absenv P V = true -> forall v m, NatSet.In v (NatSet.diff (Expressions.usedVars f) V) -> (typeExpression f) (Var Q m v) = Some m -> Is_true(isSupersetIntv (P v) (fst (absenv (Var Q m v)))). Proof. induction f; unfold validIntervalbounds. - simpl. intros approx_true v m0 v_in_fV typef; simpl in *. case_eq (mTypeEqBool m m0 && (n =? v)); intros; rewrite H in typef; inversion typef; subst. rewrite NatSet.diff_spec in v_in_fV. rewrite NatSet.singleton_spec in v_in_fV; destruct v_in_fV; subst. destruct (absenv (Var Q m0 n)); simpl in *. case_eq (NatSet.mem n V); intros case_mem; rewrite case_mem in approx_true; simpl in *. + rewrite NatSet.mem_spec in case_mem. contradiction. + apply Is_true_eq_left in approx_true. apply andb_prop_elim in approx_true. destruct approx_true; auto. - intros approx_true v0 m0 v_in_fV typef; simpl in *. inversion v_in_fV. - intros approx_unary_true v m0 v_in_fV typef; simpl in *. unfold typeExpression in typef; inversion typef. apply Is_true_eq_left in approx_unary_true. simpl in *. destruct (absenv (Unop u f)); destruct (absenv f); simpl in *. apply andb_prop_elim in approx_unary_true. destruct approx_unary_true. apply IHf; try auto. apply Is_true_eq_true; auto. - intros approx_bin_true v m0 v_in_fV typef. simpl in v_in_fV. rewrite NatSet.diff_spec in v_in_fV. destruct v_in_fV as [ v_in_fV v_not_in_V]. rewrite NatSet.union_spec in v_in_fV. apply Is_true_eq_left in approx_bin_true. case_eq (typeExpression f1 (Var Q m0 v)); case_eq (typeExpression f2 (Var Q m0 v)); intros; auto; subst. + pose proof (detTypingBinop f1 f2 b _ _ typef H0 H) as [H01 H02]; subst. destruct (absenv (Binop b f1 f2)); destruct (absenv f1); destruct (absenv f2); simpl in *. apply andb_prop_elim in approx_bin_true. destruct approx_bin_true. apply andb_prop_elim in H1. destruct H1. apply IHf1; auto. apply Is_true_eq_true; auto. rewrite NatSet.diff_spec; split; auto. eapply typedVarIsUsed; eauto. + simpl in *; rewrite H0,H in typef; inversion typef; subst. destruct (absenv (Binop b f1 f2)); destruct (absenv f1); destruct (absenv f2); simpl in *. apply andb_prop_elim in approx_bin_true. destruct approx_bin_true. apply andb_prop_elim in H1. destruct H1. apply IHf1; auto. apply Is_true_eq_true; auto. rewrite NatSet.diff_spec; split; auto. eapply typedVarIsUsed; eauto. + simpl in *; rewrite H0,H in typef; inversion typef; subst. destruct (absenv (Binop b f1 f2)); destruct (absenv f1); destruct (absenv f2); simpl in *. apply andb_prop_elim in approx_bin_true. destruct approx_bin_true. apply andb_prop_elim in H1. destruct H1. apply IHf2; auto. apply Is_true_eq_true; auto. rewrite NatSet.diff_spec; split; auto. eapply typedVarIsUsed; eauto. + simpl in *; rewrite H0,H in typef; inversion typef; subst. - intros approx_rnd_true v m0 v_in_fV typef. simpl in *; destruct (absenv (Downcast m f)); destruct (absenv f). apply Is_true_eq_left in approx_rnd_true. apply andb_prop_elim in approx_rnd_true. destruct approx_rnd_true. apply IHf; auto. apply Is_true_eq_true in H; auto. Qed. Corollary Q2R_max4 a b c d: Q2R (IntervalArithQ.max4 a b c d) = max4 (Q2R a) (Q2R b) (Q2R c) (Q2R d). Proof. unfold IntervalArithQ.max4, max4; repeat rewrite Q2R_max; auto. Qed. Corollary Q2R_min4 a b c d: Q2R (IntervalArithQ.min4 a b c d) = min4 (Q2R a) (Q2R b) (Q2R c) (Q2R d). Proof. unfold IntervalArith.min4, min4; repeat rewrite Q2R_min; auto. Qed. Ltac env_assert absenv e name := assert (exists iv err, absenv e = (iv,err)) as name by (destruct (absenv e); repeat eexists; auto). Lemma validBoundsDiv_uneq_zero e1 e2 absenv P V ivlo_e2 ivhi_e2 err: absenv e2 = ((ivlo_e2,ivhi_e2), err) -> validIntervalbounds (Binop Div e1 e2) absenv P V = true -> (ivhi_e2 < 0) \/ (0 < ivlo_e2). Proof. intros absenv_eq validBounds. unfold validIntervalbounds in validBounds. env_assert absenv (Binop Div e1 e2) abs_div; destruct abs_div as [iv_div [err_div abs_div]]. env_assert absenv e1 abs_e1; destruct abs_e1 as [iv_e1 [err_e1 abs_e1]]. rewrite abs_div, abs_e1, absenv_eq in validBounds. repeat (rewrite <- andb_lazy_alt in validBounds). apply Is_true_eq_left in validBounds. apply andb_prop_elim in validBounds. destruct validBounds as [_ validBounds]; apply andb_prop_elim in validBounds. destruct validBounds as [nodiv0 _]. apply Is_true_eq_true in nodiv0. unfold isSupersetIntv in *; simpl in *. apply le_neq_bool_to_lt_prop; auto. Qed. Lemma validVarsUnfolding_l (E:env) (absenv:analysisResult) (f1 f2: exp Q) dVars (b:binop) m0: (typeExpression (Binop b f1 f2)) (Binop b f1 f2) = Some m0 -> (forall (v : NatSet.elt) (m : mType), NatSet.mem v dVars = true -> typeExpression (Binop b f1 f2) (Var Q m v) = Some m -> exists vR : R, E v = Some (vR, M0) /\ (Q2R (fst (fst (absenv (Var Q m v)))) <= vR <= Q2R (snd (fst (absenv (Var Q m v)))))%R) -> (forall (v : NatSet.elt) (m : mType), NatSet.mem v dVars = true -> typeExpression f1 (Var Q m v) = Some m -> exists vR : R, E v = Some (vR, M0) /\ (Q2R (fst (fst (absenv (Var Q m v)))) <= vR <= Q2R (snd (fst (absenv (Var Q m v)))))%R). Proof. intros. specialize (H0 v m H1). case_eq (typeExpression f2 (Var Q m v)); intros; auto. - case_eq (mTypeEqBool m m1); intros. + (*apply EquivEqBoolEq in H4. ; rewrite <- H4 in H3.*) assert (typeExpression (Binop b f1 f2) (Var Q m v) = Some m). simpl typeExpression; rewrite H2, H3. rewrite H4; auto. specialize (H0 H5); auto. + pose proof (typingVarDet _ _ _ H3). rewrite H5 in H4. rewrite mTypeEqBool_refl in H4. inversion H4. - assert (typeExpression (Binop b f1 f2) (Var Q m v) = Some m) by (simpl; rewrite H2,H3; auto). specialize (H0 H4). auto. Qed. Lemma validVarsUnfolding_r (E:env) (absenv:analysisResult) (f1 f2: exp Q) dVars (b:binop) m0: (typeExpression (Binop b f1 f2)) (Binop b f1 f2) = Some m0 -> (forall (v : NatSet.elt) (m : mType), NatSet.mem v dVars = true -> typeExpression (Binop b f1 f2) (Var Q m v) = Some m -> exists vR : R, E v = Some (vR, M0) /\ (Q2R (fst (fst (absenv (Var Q m v)))) <= vR <= Q2R (snd (fst (absenv (Var Q m v)))))%R) -> (forall (v : NatSet.elt) (m : mType), NatSet.mem v dVars = true -> typeExpression f2 (Var Q m v) = Some m -> exists vR : R, E v = Some (vR, M0) /\ (Q2R (fst (fst (absenv (Var Q m v)))) <= vR <= Q2R (snd (fst (absenv (Var Q m v)))))%R). Proof. intros. specialize (H0 v m H1). case_eq (typeExpression f1 (Var Q m v)); intros; auto. - case_eq (mTypeEqBool m1 m); intros. + (*apply EquivEqBoolEq in H4. ; rewrite <- H4 in H3.*) assert (typeExpression (Binop b f1 f2) (Var Q m v) = Some m). simpl typeExpression; rewrite H2, H3. rewrite H4; auto. apply EquivEqBoolEq in H4; rewrite H4; auto. specialize (H0 H5); auto. + pose proof (typingVarDet _ _ _ H3). rewrite H5 in H4. rewrite mTypeEqBool_refl in H4. inversion H4. - assert (typeExpression (Binop b f1 f2) (Var Q m v) = Some m) by (simpl; rewrite H2,H3; auto). specialize (H0 H4). auto. Qed. Theorem validIntervalbounds_sound (f:exp Q) (absenv:analysisResult) (P:precond) fVars dVars (E:env): forall vR m, (typeExpression f) f = Some m -> validIntervalbounds f absenv P dVars = true -> (forall v m, NatSet.mem v dVars = true -> (typeExpression f) (Var Q m v) = Some m -> exists vR, E v = Some (vR, M0) /\ (Q2R (fst (fst (absenv (Var Q m v)))) <= vR <= Q2R (snd (fst (absenv (Var Q m v)))))%R) -> NatSet.Subset (NatSet.diff (Expressions.usedVars f) dVars) fVars -> (forall v, NatSet.mem v fVars = true -> exists vR, E v = Some (vR, M0) /\ (Q2R (fst (P v)) <= vR <= Q2R (snd (P v)))%R) -> eval_exp E (toREval (toRExp f)) vR M0 -> (Q2R (fst (fst (absenv f))) <= vR <= Q2R (snd (fst (absenv f))))%R. Proof. induction f; intros vR mf typing_ok valid_bounds valid_definedVars usedVars_subset valid_usedVars eval_f. - unfold validIntervalbounds in valid_bounds. env_assert absenv (Var Q m n) absenv_var. destruct absenv_var as [ iv [err absenv_var]]. specialize (valid_usedVars n). simpl; rewrite absenv_var in *; simpl in *. inversion eval_f; subst. case_eq (NatSet.mem n dVars); intros case_mem; rewrite case_mem in *; simpl in *. + specialize (valid_definedVars n m case_mem). assert (mTypeEqBool m m && (n =? n) = true). apply andb_true_iff; split; [ apply EquivEqBoolEq | rewrite <- beq_nat_refl ]; auto. (* rewrite H in valid_definedVars. *) (* assert (Some m = Some m) by auto. *) (* specialize (valid_definedVars H0). *) destruct valid_definedVars as [vR' [E_n_eq precond_sound]]. rewrite H; auto. rewrite E_n_eq in *. inversion H2; subst. rewrite absenv_var in *; auto. + repeat (rewrite delta_0_deterministic in *; try auto). unfold isSupersetIntv in valid_bounds. andb_to_prop valid_bounds. apply Qle_bool_iff in L0; apply Qle_bool_iff in R0. apply Qle_Rle in L0; apply Qle_Rle in R0. simpl in *. assert (NatSet.mem n fVars = true) as in_fVars. * assert (NatSet.In n (NatSet.singleton n)) as in_singleton by (rewrite NatSet.singleton_spec; auto). rewrite NatSet.mem_spec. hnf in usedVars_subset. apply usedVars_subset. rewrite NatSet.diff_spec, NatSet.singleton_spec. split; try auto. hnf; intros in_dVars. rewrite <- NatSet.mem_spec in in_dVars. rewrite in_dVars in case_mem; congruence. * specialize (valid_usedVars in_fVars); destruct valid_usedVars as [vR' [vR_def P_valid]]. rewrite vR_def in H2; inversion H2; subst. lra. - unfold validIntervalbounds in valid_bounds. simpl in *; destruct (absenv (Const m v)) as [intv err]; simpl in *. apply Is_true_eq_left in valid_bounds. apply andb_prop_elim in valid_bounds. destruct valid_bounds as [valid_lo valid_hi]. inversion eval_f; subst. rewrite delta_0_deterministic; auto. unfold contained; simpl. split. + apply Is_true_eq_true in valid_lo. unfold Qleb in *. apply Qle_bool_iff in valid_lo. apply Qle_Rle in valid_lo; auto. + apply Is_true_eq_true in valid_hi. unfold Qleb in *. apply Qle_bool_iff in valid_hi. apply Qle_Rle in valid_hi; auto. + simpl in H2; rewrite Q2R0_is_0 in H2; auto. - case_eq (absenv (Unop u f)); intros intv err absenv_unop. destruct intv as [unop_lo unop_hi]; simpl. unfold validIntervalbounds in valid_bounds. simpl in valid_bounds; rewrite absenv_unop in valid_bounds. case_eq (absenv f); intros intv_f err_f absenv_f. rewrite absenv_f in valid_bounds. apply Is_true_eq_left in valid_bounds. apply andb_prop_elim in valid_bounds. destruct valid_bounds as [valid_rec valid_unop]. apply Is_true_eq_true in valid_rec. inversion eval_f; subst. + assert (typeExpression f f = Some mf) as typing_f_ok by (simpl typeExpression in typing_ok; rewrite expEqBool_refl in typing_ok; auto). specialize (IHf v1 mf typing_f_ok valid_rec valid_definedVars usedVars_subset valid_usedVars H3). rewrite absenv_f in IHf; simpl in IHf. (* TODO: Make lemma *) unfold isSupersetIntv in valid_unop. apply andb_prop_elim in valid_unop. destruct valid_unop as [valid_lo valid_hi]. apply Is_true_eq_true in valid_lo; apply Is_true_eq_true in valid_hi. apply Qle_bool_iff in valid_lo; apply Qle_bool_iff in valid_hi. pose proof (interval_negation_valid (iv :=(Q2R (fst intv_f),(Q2R (snd intv_f)))) (a :=v1)) as negation_valid. unfold contained, negateInterval in negation_valid; simpl in *. apply Qle_Rle in valid_lo; apply Qle_Rle in valid_hi. destruct IHf. split. * eapply Rle_trans. apply valid_lo. rewrite Q2R_opp; lra. * eapply Rle_trans. Focus 2. apply valid_hi. rewrite Q2R_opp; lra. + assert (typeExpression f f = Some mf) as typing_f_ok by (simpl typeExpression in typing_ok; rewrite expEqBool_refl in typing_ok; auto). specialize (IHf v1 mf typing_f_ok valid_rec valid_definedVars usedVars_subset valid_usedVars H4). rewrite absenv_f in IHf; simpl in IHf. apply andb_prop_elim in valid_unop. destruct valid_unop as [nodiv0 valid_unop]. (* TODO: Make lemma *) unfold isSupersetIntv in valid_unop. apply andb_prop_elim in valid_unop. destruct valid_unop as [valid_lo valid_hi]. apply Is_true_eq_true in valid_lo; apply Is_true_eq_true in valid_hi. apply Qle_bool_iff in valid_lo; apply Qle_bool_iff in valid_hi. assert ((Q2R (ivhi intv_f) < 0)%R \/ (0 < Q2R (ivlo intv_f))%R) as nodiv0_prop. * apply Is_true_eq_true in nodiv0. apply le_neq_bool_to_lt_prop in nodiv0. destruct nodiv0. { left; rewrite <- Q2R0_is_0; apply Qlt_Rlt; auto. } { right; rewrite <- Q2R0_is_0; apply Qlt_Rlt; auto. } * pose proof (interval_inversion_valid (iv :=(Q2R (fst intv_f),(Q2R (snd intv_f)))) (a :=v1)) as inv_valid. unfold contained, invertInterval in inv_valid; simpl in *. apply Qle_Rle in valid_lo; apply Qle_Rle in valid_hi. destruct IHf. rewrite delta_0_deterministic; auto. unfold perturb; split. { eapply Rle_trans. apply valid_lo. destruct nodiv0_prop as [nodiv0_neg | nodiv0_pos]. (* TODO: Extract lemma maybe *) - assert (0 < - (Q2R (snd intv_f)))%R as negation_pos by lra. assert (- (Q2R (snd intv_f)) <= - v1)%R as negation_flipped_hi by lra. apply Rinv_le_contravar in negation_flipped_hi; try auto. rewrite <- Ropp_inv_permute in negation_flipped_hi; try lra. rewrite <- Ropp_inv_permute in negation_flipped_hi; try lra. apply Ropp_le_contravar in negation_flipped_hi. repeat rewrite Ropp_involutive in negation_flipped_hi; rewrite Q2R_inv; auto. hnf; intros is_0. rewrite <- Q2R0_is_0 in nodiv0_neg. apply Rlt_Qlt in nodiv0_neg; lra. - rewrite Q2R_inv. apply Rinv_le_contravar; try lra. hnf; intros is_0. assert (Q2R (fst intv_f) <= Q2R (snd intv_f))%R by lra. rewrite <- Q2R0_is_0 in nodiv0_pos. apply Rlt_Qlt in nodiv0_pos; apply Rle_Qle in H2; lra. } { eapply Rle_trans. Focus 2. apply valid_hi. destruct nodiv0_prop as [nodiv0_neg | nodiv0_pos]. - assert (Q2R (fst intv_f) < 0)%R as fst_lt_0 by lra. assert (0 < - (Q2R (fst intv_f)))%R as negation_pos by lra. assert (- v1 <= - (Q2R (fst intv_f)))%R as negation_flipped_lo by lra. apply Rinv_le_contravar in negation_flipped_lo; try auto. rewrite <- Ropp_inv_permute in negation_flipped_lo; try lra. rewrite <- Ropp_inv_permute in negation_flipped_lo; try lra. apply Ropp_le_contravar in negation_flipped_lo. repeat rewrite Ropp_involutive in negation_flipped_lo; rewrite Q2R_inv; auto. hnf; intros is_0. rewrite <- Q2R0_is_0 in negation_pos. rewrite <- Q2R_opp in negation_pos. apply Rlt_Qlt in negation_pos; lra. assert (0 < - (Q2R (snd intv_f)))%R by lra. lra. - rewrite Q2R_inv. apply Rinv_le_contravar; try lra. hnf; intros is_0. assert (Q2R (fst intv_f) <= Q2R (snd intv_f))%R by lra. rewrite <- Q2R0_is_0 in nodiv0_pos. apply Rlt_Qlt in nodiv0_pos; apply Rle_Qle in H2; lra. } { rewrite Q2R0_is_0 in H1; auto. } - inversion eval_f; subst. rewrite delta_0_deterministic in eval_f; auto. rewrite delta_0_deterministic; auto. simpl in valid_bounds. case_eq (absenv (Binop b f1 f2)); intros iv err absenv_bin. case_eq (absenv f1); intros iv1 err1 absenv_f1. case_eq (absenv f2); intros iv2 err2 absenv_f2. simpl. rewrite absenv_bin, absenv_f1, absenv_f2 in valid_bounds. apply Is_true_eq_left in valid_bounds. apply andb_prop_elim in valid_bounds. destruct valid_bounds as [valid_rec valid_bin]. apply andb_prop_elim in valid_rec. destruct valid_rec as [valid_e1 valid_e2]. apply Is_true_eq_true in valid_e1; apply Is_true_eq_true in valid_e2. pose proof (validVarsUnfolding_l _ _ _ _ _ _ typing_ok valid_definedVars) as valid_definedVars_f1. pose proof (validVarsUnfolding_r _ _ _ _ _ _ typing_ok valid_definedVars) as valid_definedVars_f2. pose proof (binop_type_unfolding _ _ _ typing_ok) as subtypes. destruct subtypes as [mf1 [mf2 [typing_f1 [typing_f2 join_f1_f2]]]]. specialize (IHf1 v1 mf1 typing_f1 valid_e1 valid_definedVars_f1). specialize (IHf2 v2 mf2 typing_f2 valid_e2 valid_definedVars_f2). rewrite absenv_f1 in IHf1. rewrite absenv_f2 in IHf2. assert ((Q2R (fst (fst (iv1, err1))) <= v1 <= Q2R (snd (fst (iv1, err1))))%R) as valid_bounds_e1. + apply IHf1; try auto. intros v in_diff_e1. apply usedVars_subset. simpl. rewrite NatSet.diff_spec,NatSet.union_spec. rewrite NatSet.diff_spec in in_diff_e1. destruct in_diff_e1 as [ in_usedVars not_dVar]. split; try auto. destruct m1; destruct m2; inversion H2; subst; auto. + assert (Q2R (fst (fst (iv2, err2))) <= v2 <= Q2R (snd (fst (iv2, err2))))%R as valid_bounds_e2. * apply IHf2; try auto. intros v in_diff_e2. apply usedVars_subset. simpl. rewrite NatSet.diff_spec, NatSet.union_spec. rewrite NatSet.diff_spec in in_diff_e2. destruct in_diff_e2; split; auto. destruct m1; destruct m2; inversion H2; auto. * destruct b; simpl in *. { pose proof (interval_addition_valid (iv1 :=(Q2R (fst iv1),Q2R (snd iv1))) (iv2 :=(Q2R (fst iv2), Q2R (snd iv2)))) as valid_add. unfold validIntervalAdd in valid_add. specialize (valid_add v1 v2 valid_bounds_e1 valid_bounds_e2). unfold contained in valid_add. unfold isSupersetIntv in valid_bin. apply andb_prop_elim in valid_bin; destruct valid_bin as [valid_lo valid_hi]. apply Is_true_eq_true in valid_lo; apply Is_true_eq_true in valid_hi. apply Qle_bool_iff in valid_lo; apply Qle_bool_iff in valid_hi. apply Qle_Rle in valid_lo; apply Qle_Rle in valid_hi. destruct valid_add as [valid_add_lo valid_add_hi]. split. - eapply Rle_trans. (*rewrite absenv_bin;*) apply valid_lo. unfold ivlo. unfold addIntv. simpl in valid_add_lo. repeat rewrite <- Q2R_plus in valid_add_lo. rewrite <- Q2R_min4 in valid_add_lo. unfold absIvUpd; auto. - eapply Rle_trans. Focus 2. (*rewrite absenv_bin;*) apply valid_hi. unfold ivlo, addIntv. simpl in valid_add_hi. repeat rewrite <- Q2R_plus in valid_add_hi. rewrite <- Q2R_max4 in valid_add_hi. unfold absIvUpd; auto. } { pose proof (interval_subtraction_valid (iv1 := (Q2R (fst iv1),Q2R (snd iv1))) (iv2 :=(Q2R (fst iv2), Q2R (snd iv2)))) as valid_sub. specialize (valid_sub v1 v2 valid_bounds_e1 valid_bounds_e2). unfold contained in valid_sub. unfold isSupersetIntv in valid_bin. apply andb_prop_elim in valid_bin; destruct valid_bin as [valid_lo valid_hi]. apply Is_true_eq_true in valid_lo; apply Is_true_eq_true in valid_hi. apply Qle_bool_iff in valid_lo; apply Qle_bool_iff in valid_hi. apply Qle_Rle in valid_lo; apply Qle_Rle in valid_hi. destruct valid_sub as [valid_sub_lo valid_sub_hi]. split. - eapply Rle_trans. (*rewrite absenv_bin;*) apply valid_lo. unfold ivlo. unfold subtractIntv. simpl in valid_sub_lo. repeat rewrite <- Rsub_eq_Ropp_Rplus in valid_sub_lo. repeat rewrite <- Q2R_minus in valid_sub_lo. rewrite <- Q2R_min4 in valid_sub_lo. unfold absIvUpd; auto. - eapply Rle_trans. Focus 2. (*rewrite absenv_bin;*) apply valid_hi. unfold ivlo, addIntv. simpl in valid_sub_hi. repeat rewrite <- Rsub_eq_Ropp_Rplus in valid_sub_hi. repeat rewrite <- Q2R_minus in valid_sub_hi. rewrite <- Q2R_max4 in valid_sub_hi. unfold absIvUpd; auto. } { pose proof (interval_multiplication_valid (iv1 :=(Q2R (fst iv1),Q2R (snd iv1))) (iv2:=(Q2R (fst iv2), Q2R (snd iv2)))) as valid_mul. specialize (valid_mul v1 v2 valid_bounds_e1 valid_bounds_e2). unfold contained in valid_mul. unfold isSupersetIntv in valid_bin. apply andb_prop_elim in valid_bin; destruct valid_bin as [valid_lo valid_hi]. apply Is_true_eq_true in valid_lo; apply Is_true_eq_true in valid_hi. apply Qle_bool_iff in valid_lo; apply Qle_bool_iff in valid_hi. apply Qle_Rle in valid_lo; apply Qle_Rle in valid_hi. destruct valid_mul as [valid_mul_lo valid_mul_hi]. split. - eapply Rle_trans. (*rewrite absenv_bin;*) apply valid_lo. unfold ivlo. unfold multIntv. simpl in valid_mul_lo. repeat rewrite <- Q2R_mult in valid_mul_lo. rewrite <- Q2R_min4 in valid_mul_lo. unfold absIvUpd; auto. - eapply Rle_trans. Focus 2. (*rewrite absenv_bin;*) apply valid_hi. unfold ivlo, addIntv. simpl in valid_mul_hi. repeat rewrite <- Q2R_mult in valid_mul_hi. rewrite <- Q2R_max4 in valid_mul_hi. unfold absIvUpd; auto. } { pose proof (interval_division_valid (a:=v1) (b:=v2) (iv1:=(Q2R (fst iv1), Q2R (snd iv1))) (iv2:=(Q2R (fst iv2),Q2R (snd iv2)))) as valid_div. rewrite <- andb_lazy_alt in valid_bin. unfold contained in valid_div. unfold isSupersetIntv in valid_bin. apply andb_prop_elim in valid_bin; destruct valid_bin as [nodiv0 valid_bin]. (** CONTINUE **) apply andb_prop_elim in valid_bin; destruct valid_bin as [valid_lo valid_hi]. apply Is_true_eq_true in valid_lo; apply Is_true_eq_true in valid_hi. apply Qle_bool_iff in valid_lo; apply Qle_bool_iff in valid_hi. apply Qle_Rle in valid_lo; apply Qle_Rle in valid_hi. apply orb_prop_elim in nodiv0. assert (snd iv2 < 0 \/ 0 < fst iv2). - destruct nodiv0 as [lt_0 | lt_0]; apply andb_prop_elim in lt_0; destruct lt_0 as [le_0 neq_0]; apply Is_true_eq_true in le_0; apply Is_true_eq_true in neq_0; apply negb_true_iff in neq_0; apply Qeq_bool_neq in neq_0; rewrite Qle_bool_iff in le_0; rewrite Qle_lteq in le_0; destruct le_0 as [lt_0 | eq_0]; [ | exfalso; apply neq_0; auto | | exfalso; apply neq_0; symmetry; auto]; auto. - destruct valid_div as [valid_div_lo valid_div_hi]; simpl; try auto. + rewrite <- Q2R0_is_0. destruct H; [left | right]; apply Qlt_Rlt; auto. + unfold divideInterval, IVlo, IVhi in valid_div_lo, valid_div_hi. simpl in *. assert (Q2R (fst iv2) <= (Q2R (snd iv2)))%R by lra. assert (~ snd iv2 == 0). * destruct H; try lra. hnf; intros ivhi2_0. apply Rle_Qle in H0. rewrite ivhi2_0 in H0. lra. * assert (~ fst iv2 == 0). { destruct H; try lra. hnf; intros ivlo2_0. apply Rle_Qle in H0. rewrite ivlo2_0 in H0. lra. } { split. - eapply Rle_trans. (*rewrite absenv_bin;*) apply valid_lo. unfold ivlo. unfold multIntv. simpl in valid_div_lo. rewrite <- Q2R_inv in valid_div_lo; [ | auto]. rewrite <- Q2R_inv in valid_div_lo; [ | auto]. repeat rewrite <- Q2R_mult in valid_div_lo. rewrite <- Q2R_min4 in valid_div_lo; auto. - eapply Rle_trans. Focus 2. (*rewrite absenv_bin;*) apply valid_hi. simpl in valid_div_hi. rewrite <- Q2R_inv in valid_div_hi; [ | auto]. rewrite <- Q2R_inv in valid_div_hi; [ | auto]. repeat rewrite <- Q2R_mult in valid_div_hi. rewrite <- Q2R_max4 in valid_div_hi; auto. } } + destruct m1; destruct m2; inversion H2. simpl in H4; rewrite Q2R0_is_0 in H4; auto. + destruct m1; destruct m2; inversion H2. simpl in H4; rewrite Q2R0_is_0 in H4; auto. - unfold validIntervalbounds in valid_bounds. (*simpl erasure in valid_bounds.*) simpl in *; destruct (absenv (Downcast m f)); destruct (absenv f); simpl in *. apply Is_true_eq_left in valid_bounds. apply andb_prop_elim in valid_bounds. destruct valid_bounds as [vI1 vI2]. apply andb_prop_elim in vI2. destruct vI2 as [vI2 vI2']. apply Is_true_eq_true in vI2. apply Is_true_eq_true in vI2'. assert (isEqIntv i i0) as Eq by (apply supIntvAntisym; auto). destruct Eq as [Eqlo Eqhi]. simpl in *. apply Qeq_eqR in Eqlo; rewrite Eqlo. apply Qeq_eqR in Eqhi; rewrite Eqhi. pose proof (expEqBool_refl (Downcast m f)); simpl in H; rewrite H in typing_ok. case_eq (typeExpression f f); intros; rewrite H0 in typing_ok. + case_eq (isMorePrecise m0 m); intros; rewrite H1 in typing_ok; inversion typing_ok. subst. apply (IHf vR m0); auto. apply Is_true_eq_true in vI1; auto. + inversion typing_ok. Qed. (* Unused, proof not up-to-date *) (* Theorem validIntervalboundsCmd_sound (f:cmd Q) (absenv:analysisResult): *) (* forall E vR fVars dVars outVars elo ehi err P, *) (* ssaPrg f (NatSet.union fVars dVars) outVars -> *) (* bstep (toREvalCmd (toRCmd f)) E vR M0 -> *) (* (forall v m, NatSet.mem v dVars = true -> *) (* exists vR, *) (* E v = Some (vR, m) /\ *) (* (Q2R (fst (fst (absenv (Var Q m v)))) <= vR <= Q2R (snd (fst (absenv (Var Q m v)))))%R) -> *) (* (forall v m, NatSet.mem v fVars = true -> *) (* exists vR, *) (* E v = Some (vR, m) /\ *) (* (Q2R (fst (P v)) <= vR <= Q2R (snd (P v)))%R) -> *) (* NatSet.Subset (NatSet.diff (Commands.freeVars f) dVars) fVars -> *) (* validIntervalboundsCmd f absenv P dVars = true -> *) (* absenv (getRetExp f) = ((elo, ehi), err) -> *) (* (Q2R elo <= vR <= Q2R ehi)%R. *) (* Proof. *) (* induction f; *) (* intros * ssa_f eval_f dVars_sound fVars_valid usedVars_subset valid_bounds_f absenv_f. *) (* - inversion ssa_f; subst. *) (* inversion eval_f; subst. *) (* unfold validIntervalboundsCmd in valid_bounds_f. *) (* andb_to_prop valid_bounds_f. *) (* inversion ssa_f; subst. *) (* specialize (IHf (updEnv n m v E) vR fVars (NatSet.add n dVars)). *) (* eapply IHf; eauto. *) (* + assert (NatSet.Equal (NatSet.add n (NatSet.union fVars dVars)) (NatSet.union fVars (NatSet.add n dVars))). *) (* * hnf. intros a; split; intros in_set. *) (* { 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. } *) (* { 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. } *) (* * eapply ssa_equal_set; eauto. *) (* symmetry; eauto. *) (* + admit. *) (* + *) (* intros v0 m0 mem_v0. *) (* unfold updEnv. *) (* case_eq (v0 =? n); intros v0_eq. *) (* * rename R1 into eq_lo; *) (* rename R0 into eq_hi. *) (* apply Qeq_bool_iff in eq_lo; *) (* apply Qeq_eqR in eq_lo. *) (* apply Qeq_bool_iff in eq_hi; *) (* apply Qeq_eqR in eq_hi. *) (* rewrite Nat.eqb_eq in v0_eq; subst. *) (* rewrite <- eq_lo, <- eq_hi. *) (* exists v; split; auto. *) (* eapply validIntervalbounds_sound; eauto. *) (* simpl in usedVars_subset. *) (* hnf. intros a in_usedVars. *) (* apply usedVars_subset. *) (* rewrite NatSet.diff_spec, NatSet.remove_spec, NatSet.union_spec. *) (* rewrite NatSet.diff_spec in in_usedVars. *) (* destruct in_usedVars as [ in_usedVars not_dVar]. *) (* repeat split; try auto. *) (* { hnf; intros; subst. *) (* specialize (H5 n in_usedVars). *) (* rewrite <- NatSet.mem_spec in H5. *) (* rewrite H5 in H6; congruence. } *) (* * apply dVars_sound. rewrite NatSet.mem_spec. *) (* rewrite NatSet.mem_spec in mem_v0. *) (* rewrite NatSet.add_spec in mem_v0. *) (* destruct mem_v0; try auto. *) (* rewrite Nat.eqb_neq in v0_eq. *) (* exfalso; apply v0_eq; auto. *) (* + intros v0 mem_fVars. *) (* unfold updEnv. *) (* case_eq (v0 =? n); intros case_v0; auto. *) (* rewrite Nat.eqb_eq in case_v0; subst. *) (* assert (NatSet.mem n (NatSet.union fVars dVars) = true) as in_union. *) (* * rewrite NatSet.mem_spec, NatSet.union_spec; rewrite <- NatSet.mem_spec; auto. *) (* * rewrite in_union in *; congruence. *) (* + clear L R1 R0 R IHf. *) (* hnf. intros a a_freeVar. *) (* rewrite NatSet.diff_spec in a_freeVar. *) (* destruct a_freeVar as [a_freeVar a_no_dVar]. *) (* apply usedVars_subset. *) (* simpl. *) (* rewrite NatSet.diff_spec, NatSet.remove_spec, NatSet.union_spec. *) (* repeat split; try auto. *) (* * hnf; intros; subst. *) (* apply a_no_dVar. *) (* rewrite NatSet.add_spec; auto. *) (* * hnf; intros a_dVar. *) (* apply a_no_dVar. *) (* rewrite NatSet.add_spec; auto. *) (* - unfold validIntervalboundsCmd in valid_bounds_f. *) (* inversion eval_f; subst. *) (* unfold updEnv. *) (* assert (Q2R (fst (fst (absenv (erasure e)))) <= vR <= Q2R (snd (fst (absenv (erasure e)))))%R. *) (* + simpl in valid_bounds_f; eapply validIntervalbounds_sound; eauto. *) (* + simpl in *. rewrite absenv_f in *; auto. *) (* Qed. *)